diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,482 @@ + GNU LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, 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 +this service 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 make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +General Public License (also called "this License"). Each licensee is +addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also compile or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + c) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + d) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the source code distributed need not include anything that is normally +distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Library General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,9 @@ +This is the bootstrap-version of UUAGC. + +It should be used to compile the actual version of UUAG from source. +This package should be updated to prevent it from bitrotting with +respect to library and language changes. +This package does *not* require UUAG to be installed. Instead, it +has the "derived" files in the src-derived directory. +To update it, copy the generated .hs files (in dist/build of the +boostrapped UUAG) to the the src-derived directory. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ + +import Distribution.Simple +main = defaultMain diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC.hs b/cabal-plugin/src/Distribution/Simple/UUAGC.hs new file mode 100644 --- /dev/null +++ b/cabal-plugin/src/Distribution/Simple/UUAGC.hs @@ -0,0 +1,5 @@ +module Distribution.Simple.UUAGC(uuagcUserHook + ,uuagc) where + +import Distribution.Simple.UUAGC.UUAGC + diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC/AbsSyn.hs b/cabal-plugin/src/Distribution/Simple/UUAGC/AbsSyn.hs new file mode 100644 --- /dev/null +++ b/cabal-plugin/src/Distribution/Simple/UUAGC/AbsSyn.hs @@ -0,0 +1,160 @@ +module Distribution.Simple.UUAGC.AbsSyn where + +import Distribution.Simple.UUAGC.Options +import System.FilePath(normalise) + +data AGFileOption = AGFileOption {filename :: String, + fileClasses :: [String], + opts :: UUAGCOptions} + deriving (Show, Eq) + +data AGOptionsClass = AGOptionsClass {className :: String, opts' :: UUAGCOptions} + deriving (Show, Read, Eq) + +type AGFileOptions = [AGFileOption] + +data UUAGCOption = UModuleDefault + | UModule String + | UData + | UStrictData + | UStrictWData + | UCatas + | USemFuns + | USignatures + | UNewTypes + | UPretty + | UWrappers + | URename + | UModCopy + | UNest + | USyntaxMacro + | UOutput FilePath + | UVerbose + | UHelp -- ? + | UAll + | USearchPath FilePath + | UPrefix String + | USelf + | UCycle + | UVersion -- ? + | UVisit + | USeq + | UUnbox -- UUnbox + | UBangPats + | UCase + | UStrictCase + | UStricterCase + | ULocalCPS + | USplitSems + | UWErrors + | UWIgnore + | UWMax Int + | UDumpGrammar + | UDumpCGrammar + | UGenTraces + | UGenUseTraces + | UGenCostCentres + | UGenLinePragmas + | USepSemMods + | UGenFileDeps + | UGenVisage + | UGenAspectAG + | UGenAttrList + | UForceIrrefutable FilePath + | UUniqueDispenser String + | ULCKeyWords + | UOptimize + | UDoubleColons + | UHaskellSyntax + | UStatistics FilePath + | UCheckParseRhs + | UCheckParseTys + | UCheckParseBlocks + | UCheckParseHaskell + deriving (Eq, Read, Show) + +type UUAGCOptions = [UUAGCOption] + +defaultUUAGCOptions :: UUAGCOptions +defaultUUAGCOptions = [UData + ,UCatas + ,USemFuns + ,USignatures + ,UPretty + ,UWrappers + ,URename + ,UModuleDefault + ] + +optionTxt = "--" +equalTxt = "=" + +toLOp s = optionTxt ++ s +toLEOpA s a = (toLOp s) ++ equalTxt ++ a + +fromUUAGCOtoArgs :: UUAGCOption -> String +fromUUAGCOtoArgs (UModule s) = toLEOpA omodule s +fromUUAGCOtoArgs UData = toLOp odata +fromUUAGCOtoArgs UStrictData = toLOp ostrictdata +fromUUAGCOtoArgs UStrictWData = toLOp ostrictwrap +fromUUAGCOtoArgs UCatas = toLOp ocatas +fromUUAGCOtoArgs USemFuns = toLOp osemfuns +fromUUAGCOtoArgs USignatures = toLOp osignatures +fromUUAGCOtoArgs UNewTypes = toLOp onewtypes +fromUUAGCOtoArgs UPretty = toLOp opretty +fromUUAGCOtoArgs UWrappers = toLOp owrappers +fromUUAGCOtoArgs URename = toLOp orename +fromUUAGCOtoArgs UModCopy = toLOp omodcopy +fromUUAGCOtoArgs UNest = toLOp onest +fromUUAGCOtoArgs USyntaxMacro = toLOp osyntaxmacro +fromUUAGCOtoArgs (UOutput fp) = toLEOpA ooutput fp +fromUUAGCOtoArgs UVerbose = toLOp overbose +fromUUAGCOtoArgs (USearchPath fp) = toLEOpA "" fp +fromUUAGCOtoArgs (UPrefix p) = toLEOpA oprefix p +fromUUAGCOtoArgs USelf = toLOp oself +fromUUAGCOtoArgs UCycle = toLOp ocycle +fromUUAGCOtoArgs UVersion = toLOp oversion +fromUUAGCOtoArgs UVisit = toLOp ovisit +fromUUAGCOtoArgs USeq = toLOp oseq +fromUUAGCOtoArgs UUnbox = toLOp ounbox +fromUUAGCOtoArgs UBangPats = toLOp obangpats +fromUUAGCOtoArgs UCase = toLOp ocase +fromUUAGCOtoArgs UStrictCase = toLOp ostrictcase +fromUUAGCOtoArgs UStricterCase = toLOp ostrictercase +fromUUAGCOtoArgs ULocalCPS = toLOp olocalcps +fromUUAGCOtoArgs USplitSems = toLOp osplitsems +fromUUAGCOtoArgs UWErrors = toLOp owerrors +fromUUAGCOtoArgs UWIgnore = toLOp owignore +fromUUAGCOtoArgs (UWMax i) = toLEOpA owmax (show i) +fromUUAGCOtoArgs UDumpGrammar = toLOp odumpgrammar +fromUUAGCOtoArgs UDumpCGrammar = toLOp odumpcgrammar +fromUUAGCOtoArgs UGenTraces = toLOp ogentraces +fromUUAGCOtoArgs UGenUseTraces = toLOp ogenusetraces +fromUUAGCOtoArgs UGenCostCentres = toLOp ogencostcentres +fromUUAGCOtoArgs UGenLinePragmas = toLOp ogenlinepragmas +fromUUAGCOtoArgs USepSemMods = toLOp osepsemmods +fromUUAGCOtoArgs UGenFileDeps = toLOp ogenfiledeps +fromUUAGCOtoArgs UGenVisage = toLOp ogenvisage +fromUUAGCOtoArgs UGenAspectAG = toLOp ogenaspectag +fromUUAGCOtoArgs UGenAttrList = toLOp ogenattrlist +fromUUAGCOtoArgs (UForceIrrefutable fp) = toLEOpA oforceirrefutable fp +fromUUAGCOtoArgs (UUniqueDispenser nm) = toLEOpA ouniquedispenser nm +fromUUAGCOtoArgs UOptimize = toLOp ooptimize +fromUUAGCOtoArgs UModuleDefault = toLOp omodule +fromUUAGCOtoArgs UHaskellSyntax = toLOp ohaskellsyntax +fromUUAGCOtoArgs UDoubleColons = toLOp odoublecolons +fromUUAGCOtoArgs ULCKeyWords = toLOp olckeywords +fromUUAGCOtoArgs (UStatistics fp) = toLEOpA ostatistics fp +fromUUAGCOtoArgs UCheckParseRhs = toLOp ocheckparserhs +fromUUAGCOtoArgs UCheckParseTys = toLOp ocheckparsetys +fromUUAGCOtoArgs UCheckParseBlocks = toLOp ocheckparseblocks +fromUUAGCOtoArgs UCheckParseHaskell = toLOp ocheckparsehaskell + +fromUUAGCOstoArgs :: UUAGCOptions -> [String] +fromUUAGCOstoArgs = map fromUUAGCOtoArgs + +lookupFileOptions :: FilePath -> AGFileOptions -> UUAGCOptions +lookupFileOptions s = foldl f defaultUUAGCOptions + where f e (AGFileOption s' classes opt) + | s == (normalise s') = opt + | otherwise = e diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC/Options.hs b/cabal-plugin/src/Distribution/Simple/UUAGC/Options.hs new file mode 100644 --- /dev/null +++ b/cabal-plugin/src/Distribution/Simple/UUAGC/Options.hs @@ -0,0 +1,59 @@ +module Distribution.Simple.UUAGC.Options where + +odata = "data" +ostrictdata = "strictdata" +ostrictwrap = "strictwrap" +ocatas = "catas" +osemfuns = "semfuns" +osignatures = "signatures" +onewtypes = "newtypes" +opretty = "pretty" +owrappers = "wrappers" +orename = "rename" +omodcopy = "modcopy" +onest = "nest" +osyntaxmacro = "syntaxmacro" +overbose = "verbose" +ohelp = "help" +oself = "self" +ocycle = "cycle" +oversion = "version" +ovisit = "visit" +oseq = "seq" +ounbox = "unbox" +obangpats = "bangpats" +ocase = "case" +ostrictcase = "strictcase" +ostrictercase = "strictercase" +olocalcps = "localcps" +osplitsems = "splitsems" +owerrors = "Werrors" +owignore = "Wignore" +owmax = "Wmax" +odumpgrammar = "dumpgrammar" +odumpcgrammar = "dumpcgrammar" +ogentraces = "gentraces" +ogenusetraces = "genusetraces" +ogencostcentres = "gencostcentres" +ogenlinepragmas = "genlinepragmas" +osepsemmods = "sepsemmods" +ogenfiledeps = "genfiledeps" +ogenvisage = "genvisage" +ogenaspectag = "genAspectAG" +ogenattrlist = "genattrlist" +oforceirrefutable = "forceirrefutable" +ouniquedispenser = "uniquedispenser" +olckeywords = "lckeywords" +ooptimize = "optimize" +odoublecolons = "doublecolons" +ohaskellsyntax = "haskellsyntax" +oall = "all" +omodule = "module" +ooutput = "output" +osearch = "path" +oprefix = "prefix" +ostatistics = "statistics" +ocheckparserhs = "checkParseRhs" +ocheckparsetys = "checkParseTys" +ocheckparseblocks = "checkParseBlocks" +ocheckparsehaskell = "checkParseHaskell" diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC/Parser.hs b/cabal-plugin/src/Distribution/Simple/UUAGC/Parser.hs new file mode 100644 --- /dev/null +++ b/cabal-plugin/src/Distribution/Simple/UUAGC/Parser.hs @@ -0,0 +1,209 @@ +{-# OPTIONS_GHC -XScopedTypeVariables #-} +module Distribution.Simple.UUAGC.Parser(parserAG, + parserAG', + scanner, + parseIOAction, + parseClassAG, + parseOptionAG) where + +import UU.Parsing +import UU.Scanner +import Distribution.Simple.UUAGC.AbsSyn +import Distribution.Simple.UUAGC.Options +import System.IO.Unsafe(unsafeInterleaveIO) +import System.IO(hPutStr,stderr) +import Control.Monad.Error + +data (Show a) => ParserError a = ParserError a + | DefParserError String + deriving (Show, Eq, Read) + +instance Error (ParserError a) where + strMsg x = DefParserError x + +-- import Control.Exception + +uFlags = [odata, ostrictdata, ostrictwrap, ocatas, osemfuns, osignatures + ,onewtypes, opretty + ,owrappers, orename, omodcopy, onest, osyntaxmacro, overbose + ,ohelp, ocycle, oversion, ovisit, oseq, ounbox, obangpats + ,ocase, ostrictcase, ostrictercase, olocalcps, osplitsems + ,owerrors, owignore, odumpgrammar, odumpcgrammar, ogentraces + ,ogenusetraces, ogencostcentres, ogenlinepragmas, osepsemmods + ,ogenfiledeps, ogenvisage, ogenaspectag, ogenattrlist, olckeywords + ,odoublecolons, oself + ,ocheckparserhs,ocheckparsetys,ocheckparseblocks,ocheckparsehaskell] + +uabsFlags = [UData, UStrictData, UStrictWData, UCatas, USemFuns, USignatures + ,UNewTypes, UPretty + ,UWrappers, URename, UModCopy, UNest, USyntaxMacro, UVerbose + ,UHelp, UCycle, UVersion, UVisit, USeq, UUnbox, UBangPats + ,UCase, UStrictCase, UStricterCase, ULocalCPS, USplitSems + ,UWErrors, UWIgnore, UDumpGrammar, UDumpCGrammar, UGenTraces + ,UGenUseTraces, UGenCostCentres, UGenLinePragmas, USepSemMods + ,UGenFileDeps, UGenVisage, UGenAspectAG, UGenAttrList, ULCKeyWords + ,UDoubleColons, USelf + ,UCheckParseRhs, UCheckParseTys, UCheckParseBlocks, UCheckParseHaskell] + +gFlags = [(oall, [odata, ocatas, osemfuns, osignatures, opretty, orename]) + ,(ooptimize, [ovisit,ocase]) + ,(ohaskellsyntax, [olckeywords, odoublecolons,ogenlinepragmas]) + ] + +gabsFlags = [UAll, UOptimize, UHaskellSyntax] + + +aFlags = [omodule, ooutput, osearch, oprefix, owmax, oforceirrefutable, ouniquedispenser, ostatistics] + +ugFlags = uFlags ++ (map (fst) gFlags) + +ugabsFlags = uabsFlags ++ gabsFlags + +kwtxt = uFlags ++ (map fst gFlags) ++ aFlags ++ ["file", "options", "class", "with"] +kwotxt = ["=",":","..","."] +sctxt = "..," +octxt = "=:.," + +posTxt :: Pos +posTxt = Pos 0 0 "" + +puFlag :: UUAGCOption -> String -> Parser Token UUAGCOption +puFlag opt sopt = opt <$ pKey sopt + + +pugFlags :: [Parser Token UUAGCOption] +pugFlags = zipWith puFlag ugabsFlags ugFlags + +pModule :: Parser Token UUAGCOption +pModule = UModuleDefault <$ pKey omodule + <|> UModule <$> (pKey omodule *> pString) + +pOutput :: Parser Token UUAGCOption +pOutput = UOutput <$> (pKey ooutput *> pString) + +pSearch :: Parser Token UUAGCOption +pSearch = USearchPath <$> (pKey osearch *> pString) + +pPrefix :: Parser Token UUAGCOption +pPrefix = UPrefix <$> (pKey oprefix *> pString) + +pWmax :: Parser Token UUAGCOption +pWmax = f <$> (pKey owmax *> pInteger) + where f x = UWMax (read x) + +pForceIrrefutable :: Parser Token UUAGCOption +pForceIrrefutable = UForceIrrefutable <$> (pKey oforceirrefutable *> pString) + +pUniqueDispenser :: Parser Token UUAGCOption +pUniqueDispenser = UUniqueDispenser <$> (pKey ouniquedispenser *> pString) + +pStatistics :: Parser Token UUAGCOption +pStatistics = UStatistics <$> (pKey ostatistics *> pString) + +pAllFlags = pugFlags ++ [pModule,pOutput,pSearch,pPrefix,pWmax,pForceIrrefutable,pUniqueDispenser,pStatistics] + +pAnyFlag = pAny id pAllFlags + +pSep :: Parser Token String +pSep = pKey ":" <|> pKey "=" + +pFileClasses :: Parser Token [String] +pFileClasses = pKey "with" *> (pCommas pString) + <|> pSucceed [] + +pLiftOptions :: (String -> [UUAGCOption] -> a) -> String -> Parser Token a +pLiftOptions f n = f <$> (pKey n *> pSep *> pString) + <*> (pKey "options" *> pSep *> pCommas pAnyFlag) + +pAGFileOption :: Parser Token AGFileOption +pAGFileOption = AGFileOption <$> (pKey "file" *> pSep *> pString) + <*> pFileClasses + <*> (pKey "options" *> pSep *> pCommas pAnyFlag) + +pAGOptionsClass :: Parser Token AGOptionsClass +pAGOptionsClass = pLiftOptions AGOptionsClass "class" + +pAGFileOptions :: Parser Token AGFileOptions +pAGFileOptions = pList pAGFileOption + +parserAG :: FilePath -> IO AGFileOptions +parserAG fp = do s <- readFile fp + parseIOAction action pAGFileOptions (scanner fp s) + +parserAG' :: FilePath -> IO (Either (ParserError String) AGFileOptions) +parserAG' fp = do s <- readFile fp + let steps = parse pAGFileOptions (scanner fp s) + let (Pair res _, mesg) = evalStepsMessages steps + if null mesg + then return $ Right res + else do let err = foldr (++) [] $ map message2error mesg + return (Left $ ParserError err) + +message2error :: Message Token (Maybe Token) -> String +message2error (Msg e p a) = "Expecting: " ++ (show e) ++ " at " ++ action + where action = case a of + Insert s -> " Inserting: " ++ (show s) + Delete s -> " Deleting: " ++ (show s) + Other s -> s + +liftParse p text = parseIOAction action p (scanner text text) + +parseOptionAG :: String -> IO AGFileOption +parseOptionAG = liftParse pAGFileOption + +parseClassAG :: String -> IO AGOptionsClass +parseClassAG = liftParse pAGOptionsClass + +scanner :: String -> String -> [Token] +scanner fn s = scan kwtxt kwotxt sctxt octxt (Pos 0 0 fn) s + +action :: (Eq s, Show s, Show p) => Message s p -> IO () +action m = hPutStr stderr (show m) + +test :: (Show a) => Parser Token a -> [Token] -> IO () +test p inp = do r <- parseIOAction action p inp + print r + +parseIOAction :: (Symbol s, InputState inp s p) + => (Message s p -> IO ()) + -> AnaParser inp Pair s p a + -> inp + -> IO a +parseIOAction showMessage p inp + = do (Pair v final) <- evalStepsIOAction showMessage (parse p inp) + final `seq` return v -- in order to force the trailing error messages to be printed + +evalStepsIOAction :: (Message s p -> IO ()) + -> Steps b s p + -> IO b +evalStepsIOAction showMessage = evalStepsIOAction' showMessage (-1) + + +evalStepsIOAction' :: (Message s p -> IO ()) + -> Int + -> Steps b s p + -> IO b +evalStepsIOAction' showMessage n (steps :: Steps b s p) = eval n steps + where eval :: Int -> Steps a s p -> IO a + eval 0 steps = return (evalSteps steps) + eval n steps = case steps of + OkVal v rest -> do arg <- unsafeInterleaveIO (eval n rest) + return (v arg) + Ok rest -> eval n rest + Cost _ rest -> eval n rest + StRepair _ msg rest -> do showMessage msg + eval (n-1) rest + Best _ rest _ -> eval n rest + NoMoreSteps v -> return v + + +evalStepsMessages :: (Eq s, Show s, Show p) => Steps a s p -> (a,[Message s p]) +evalStepsMessages steps = case steps of + OkVal v rest -> let (arg, ms) = evalStepsMessages rest + in (v arg, ms) + Ok rest -> evalStepsMessages rest + Cost _ rest -> evalStepsMessages rest + StRepair _ msg rest -> let (v, ms) = evalStepsMessages rest + in (v, msg:ms) + Best _ rest _ -> evalStepsMessages rest + NoMoreSteps v -> (v,[]) diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC/UUAGC.hs b/cabal-plugin/src/Distribution/Simple/UUAGC/UUAGC.hs new file mode 100644 --- /dev/null +++ b/cabal-plugin/src/Distribution/Simple/UUAGC/UUAGC.hs @@ -0,0 +1,263 @@ +{-# LANGUAGE CPP #-} + +module Distribution.Simple.UUAGC.UUAGC(uuagcUserHook, + uuagc + ) where +import Distribution.Simple.BuildPaths (autogenModulesDir) +import Debug.Trace +import Distribution.Simple +import Distribution.Simple.PreProcess +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Utils +import Distribution.Simple.Setup +import Distribution.PackageDescription hiding (Flag) +import Distribution.Simple.UUAGC.AbsSyn( AGFileOption(..) + , AGFileOptions + , AGOptionsClass(..) + , UUAGCOption(..) + , UUAGCOptions + , defaultUUAGCOptions + , fromUUAGCOtoArgs + , fromUUAGCOstoArgs + , lookupFileOptions + , fileClasses + ) +import Distribution.Simple.UUAGC.Parser +import Distribution.Verbosity +import System.Process( CreateProcess(..), createProcess, CmdSpec(..) + , StdStream(..), runProcess, waitForProcess + , proc) +import System.Directory(getModificationTime + ,doesFileExist + ,removeFile) +import System.FilePath(pathSeparators, + (), + takeFileName, + normalise, + joinPath, + dropFileName, + addExtension, + dropExtension) + +import System.Exit (ExitCode(..)) +import System.IO( openFile, IOMode(..), + hFileSize, + hSetFileSize, + hClose, + hGetContents, + hFlush, + Handle(..), stderr, hPutStr, hPutStrLn) +import System(exitFailure) +import Control.Exception (throwIO) +import Control.Monad (liftM, when, guard, forM_, forM) +import Control.Arrow ((&&&), second) +import Data.Maybe (maybeToList) +import Data.Either (partitionEithers) +import Data.List (nub) + +-- | 'uuagc' returns the name of the uuagc compiler +uuagcn = "uuagc" + +-- | 'defUUAGCOptions' returns the default names of the uuagc options +defUUAGCOptions = "uuagc_options" + +-- | File used to store de classes defined in the cabal file. +agClassesFile = ".ag_file_options" + +-- | The prefix used for the cabal file optionsw +agModule = "x-agmodule" + +-- | The prefix used for the cabal file options used for defining classes +agClass = "x-agclass" + +uuagcUserHook :: UserHooks +uuagcUserHook = simpleUserHooks {hookedPreProcessors = ("ag", uuagc):("lag",uuagc):knownSuffixHandlers + ,buildHook = uuagcBuildHook + ,postBuild = uuagcPostBuild + } + +originalPreBuild = preBuild simpleUserHooks +originalBuildHook = buildHook simpleUserHooks + +processContent :: Handle -> IO [String] +processContent = liftM words . hGetContents + +putErrorInfo :: Handle -> IO () +putErrorInfo h = hGetContents h >>= hPutStr stderr + +addSearch :: String -> [String] -> [String] +addSearch sp fl = let sf = [head pathSeparators] + path = if sp == "" + then '.' : sf + else sp ++ sf + in [normalise (joinPath [sp,f]) | f <- fl] + +throwFailure :: IO () +throwFailure = throwIO $ ExitFailure 1 + +-- The tmp build directory really depends on the type of project. +-- In the case executables it uses the name of the generated file for +-- the output directory. +withBuildTmpDir + :: PackageDescription + -> LocalBuildInfo + -> (FilePath -> IO ()) + -> IO () +withBuildTmpDir pkgDescr lbi f = do +#if MIN_VERSION_Cabal(1,8,0) + withLib pkgDescr $ \ _ -> f $ buildDir lbi +#else + withLib pkgDescr () $ \ _ -> f $ buildDir lbi +#endif + withExe pkgDescr $ \ theExe -> + f $ buildDir lbi exeName theExe exeName theExe ++ "-tmp" + +-- Creates the output file given the main preprocessed file and the buildtmp folder +tmpFile :: FilePath -> FilePath -> FilePath +tmpFile buildTmp = (buildTmp ) + . (`addExtension` "hs") + . dropExtension + . takeFileName + +-- | 'updateAGFile' search into the uuagc options file for a list of all +-- AG Files and theirs file dependencies in order to see if the latters +-- are more updated that the formers, and if this is the case to +-- update the AG File +updateAGFile :: PackageDescription + -> LocalBuildInfo + -> (FilePath, String) + -> IO () +updateAGFile pkgDescr lbi (f, sp) = do + fileOpts <- readFileOptions + let opts = case lookup f fileOpts of + Nothing -> [] + Just x -> x + modeOpts = filter isModeOption opts + isModeOption UHaskellSyntax = True + isModeOption ULCKeyWords = True + isModeOption UDoubleColons = True + isModeOption _ = False + (_, Just ppOutput, Just ppError, ph) <- newProcess modeOpts + ec <- waitForProcess ph + case ec of + ExitSuccess -> + do fls <- processContent ppOutput + let flsC = addSearch sp fls + when ((not.null) flsC) $ do + flsmt <- mapM getModificationTime flsC + let maxModified = maximum flsmt + removeTmpFile f = do + exists <- doesFileExist f + when exists $ do + fmt <- getModificationTime f + when (maxModified > fmt) $ removeFile f + withBuildTmpDir pkgDescr lbi $ removeTmpFile . (`tmpFile` f) + (ExitFailure exc) -> + do putErrorInfo ppOutput + putErrorInfo ppError + throwFailure + where newProcess mopts = createProcess $ (proc uuagcn (fromUUAGCOstoArgs mopts ++ ["--genfiledeps" + ,"--=" ++ intercalate ":" [sp] + ,f + ] + ) + ) + { std_in = Inherit + , std_out = CreatePipe + , std_err = CreatePipe + } + +getAGFileOptions :: [(String, String)] -> IO AGFileOptions +getAGFileOptions extra = do + usesOptionsFile <- doesFileExist defUUAGCOptions + if usesOptionsFile + then do r <- parserAG' defUUAGCOptions + case r of + Left e -> print e >> exitFailure + Right a -> return a + else mapM (parseOptionAG . snd) + $ filter ((== agModule) . fst) extra + +getAGClasses :: [(String, String)] -> IO [AGOptionsClass] +getAGClasses = mapM (parseClassAG . snd) . filter ((== agClass) . fst) + +writeFileOptions :: [(String, [UUAGCOption])] -> IO () +writeFileOptions opts = do + hClasses <- openFile agClassesFile WriteMode + hPutStr hClasses $ show opts + hFlush hClasses + hClose hClasses + +readFileOptions :: IO [(String, [UUAGCOption])] +readFileOptions = do + hClasses <- openFile agClassesFile ReadMode + sClasses <- hGetContents hClasses + classes <- readIO sClasses :: IO [(String, [UUAGCOption])] + hClose hClasses + return $ classes + +getOptionsFromClass :: [(String, [UUAGCOption])] -> AGFileOption -> ([String], [UUAGCOption]) +getOptionsFromClass classes fOpt = + second (nub . concat . ((opts fOpt):)) + . partitionEithers $ do + fClass <- fileClasses fOpt + case fClass `lookup` classes of + Just x -> return $ Right x + Nothing -> return $ Left $ "Warning: The class " + ++ show fClass + ++ " is not defined." + +uuagcBuildHook + :: PackageDescription + -> LocalBuildInfo + -> UserHooks + -> BuildFlags + -> IO () +uuagcBuildHook pd lbi uh bf = do + let lib = library pd + exes = executables pd + bis = map libBuildInfo (maybeToList lib) ++ map buildInfo exes + classes <- map (className &&& opts') `fmap` (getAGClasses . customFieldsPD $ pd) + options <- getAGFileOptions (bis >>= customFieldsBI) + fileOptions <- forM options (\ opt -> + let (notFound, opts) = getOptionsFromClass classes $ opt + in do case buildVerbosity bf of + Flag v | v >= verbose -> putStrLn ("options for " ++ filename opt ++ ": " ++ show opts) + _ -> return () + forM_ notFound (hPutStrLn stderr) >> return (normalise . filename $ opt, opts)) + writeFileOptions fileOptions + let agflSP = map (id &&& dropFileName) $ nub $ getAGFileList options + mapM_ (updateAGFile pd lbi) agflSP + originalBuildHook pd lbi uh bf + +uuagcPostBuild _ _ _ _ = do + exists <- doesFileExist agClassesFile + when exists $ removeFile agClassesFile + +getAGFileList :: AGFileOptions -> [FilePath] +getAGFileList = map (normalise . filename) + +uuagc :: BuildInfo + -> LocalBuildInfo + -> PreProcessor +uuagc build local = + PreProcessor { + platformIndependent = True, + runPreProcessor = mkSimplePreProcessor $ \ inFile outFile verbosity -> + do info verbosity $ concat [inFile, " has been preprocessed into ", outFile] + print $ "processing: " ++ inFile ++ " generating: " ++ outFile +-- opts <- getAGFileOptions $ customFieldsBI build + fileOpts <- readFileOptions + let opts = case lookup inFile fileOpts of + Nothing -> [] + Just x -> x + search = dropFileName inFile + options = fromUUAGCOstoArgs opts + ++ ["-P" ++ search, "--output=" ++ outFile, inFile] + (_,_,_,ph) <- createProcess (proc uuagcn options) + eCode <- waitForProcess ph + case eCode of + ExitSuccess -> return () + ExitFailure _ -> throwFailure + } + diff --git a/src-derived/AG2AspectAG.hs b/src-derived/AG2AspectAG.hs new file mode 100644 --- /dev/null +++ b/src-derived/AG2AspectAG.hs @@ -0,0 +1,2050 @@ + + +-- UUAGC 0.9.38.1 (AG2AspectAG.ag) +module AG2AspectAG where +{-# LINE 7 "AG2AspectAG.ag" #-} + +import Options + +import Data.Char +import Data.List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe + +import Pretty +import PPUtil +import UU.Scanner.Position + +import AbstractSyntax +import TokenDef +import CommonTypes +{-# LINE 23 "../src-derived/AG2AspectAG.hs" #-} + +{-# LINE 2 "./AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 33 "../src-derived/AG2AspectAG.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 40 "../src-derived/AG2AspectAG.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 46 "../src-derived/AG2AspectAG.hs" #-} + +{-# LINE 2 "./HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 52 "../src-derived/AG2AspectAG.hs" #-} +{-# LINE 25 "AG2AspectAG.ag" #-} + +pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}" + +importAspectAG = pp "import Language.Grammars.AspectAG" >-< + pp "import Language.Grammars.AspectAG.Derive" >-< + pp "import Data.HList.Label4" >-< + pp "import Data.HList.TypeEqGeneric1" >-< + pp "import Data.HList.TypeCastGeneric1" + +{-# LINE 63 "../src-derived/AG2AspectAG.hs" #-} + +{-# LINE 109 "AG2AspectAG.ag" #-} + + +prodName :: Bool -> PP_Doc -> PP_Doc -> PP_Doc +prodName rename ppNt ppCon | rename = ppListSep "" "" "_" [ppNt, ppCon] + | otherwise = ppCon + + +{-# LINE 73 "../src-derived/AG2AspectAG.hs" #-} + +{-# LINE 178 "AG2AspectAG.ag" #-} + + +defAtts = pp "data Att_inh; att_inh = proxy :: Proxy Att_inh" >-< + pp "data Att_syn; att_syn = proxy :: Proxy Att_syn" >-< + pp "data Att_loc; att_loc = proxy :: Proxy Att_loc" + + +defTAtt t@(f:r) ppN atts = + let tT = (toUpper f) : r + fields = ppCommas (map (\(a,t) -> ppListSep "" "" "_" [pp a, pp tT, ppN ] >|< pp " ::" >|< ppShow t) $ Map.assocs atts) + in + pp ("data " ++ tT ++ "_") >|< ppN >|< pp (" = " ++ tT ++ "_") >|< ppN >|< + pp " { " >|< fields >|< pp " }" + + +defLocalAtts ppNt ppProd total actual (l:ls) = ppListSep "" "" "_" [pp l, ppNt, ppProd] >|< + ppListSep "(" ")" "," (replicate (actual-1) "_" ++ "x" : replicate (total-actual) "_") >|< + pp " = x" >-< + defLocalAtts ppNt ppProd total (actual+1) ls +defLocalAtts _ _ _ _ [] = empty + +{-# LINE 97 "../src-derived/AG2AspectAG.hs" #-} + +{-# LINE 271 "AG2AspectAG.ag" #-} + + +defInhRule ppNt prod ch rules chids locals = + let ppAtt = ppListSep "" "" "_" [pp "inh", ppNt, pp prod] + in ppAtt >|< pp " = inhdefM att_inh listNt $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 (foldr (>-<) (pp "emptyRecord") (map (chRule ppNt prod rules chids locals) chids)) + +chRule ppNt prod rules chids locals (idCh,tp) = + let chName = ppListSep "" "" "_" [pp "ch", pp idCh, ppNt, pp prod] + ppTp = ppShow tp + chRules = ppCommas $ mapRuleDefs (== idCh) rules chids locals + in if (isNonterminal tp) + then chName >|< ".=." >-< + indent 1 "Inh_" >|< ppShow tp >|< pp " {" >-< + indent 2 chRules >-< + indent 1 "} .*. " + else empty + + +defSynRule ppNt prod ch rules chids locals = + let ppAtt = ppListSep "" "" "_" [pp "syn", ppNt, pp prod] + ppTAtt = "Syn_" >|< ppNt + in ppAtt >|< pp " = syndefM att_syn $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 ppTAtt >|< pp " {" >-< + indent 7 (ppCommas $ mapRuleDefs ((== "lhs") . show) rules chids locals) >-< + indent 6 "}" + +defLocRule ppNt prod ch rules chids locals = + let ppAtt = ppListSep "" "" "_" [pp "loc", ppNt, pp prod] + ppTAtt = ppListSep "" "" "_" [pp "Loc", ppNt, pp prod] + in ppAtt >|< pp " = locdefM att_loc $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 (ppListSep "(" ")" "," $ mapRuleDefs ((== "loc") . show) rules chids locals) + +defInstRules ppNt prod ch rules chids locals = let ppAsp = ppListSep "" "" "_" [pp "inst", ppNt, pp prod] + instRules = filter ((=="inst") . show . fst . fst) rules + ppAtt att = ppListSep "`ext` " "" "_" [pp "inst_ch", pp att, ppNt, pp prod] + in ppAsp >|< pp " = emptyRule " >|< (map (ppAtt . snd . fst) instRules) >-< + (vlist $ map (defInstRule ppNt prod ch chids locals) instRules) + + +defInstRule ppNt prod ch chids locals ((_,att),rule) = + let ppAtt = ppListSep "" "" "_" [pp "ch", pp att, ppNt, pp prod] + in pp "inst_" >|< ppAtt >|< pp " = instdefM " >|< ppAtt >|< pp " $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 (rule chids locals) + + +mapRuleDefs filt rules chids locals = map appSnd $ sortBy cmpFst $ filter ( filt . fst . fst) rules + where cmpFst (a,_) (b,_) = compare a b + appSnd rule = (snd rule) chids locals + +defRule ppNt (field,att) rhs = \chids locals -> + let ppAtt = case (show field) of + "lhs" -> att >|< "_" >|< pp "Syn" >|< pp "_" >|< ppNt >|< " = " + "loc" -> empty + "inst" -> empty + otherwise -> att >|< "_" >|< pp "Inh" >|< pp "_" >|< + (maybe (error $ "lhs field " ++ show field ++" is not a child") ppShow (lookup field chids)) + >|< " = " + in ppAtt >|< (rhs field chids locals) + + +rhsRule ppNt ppProd tks field chids locals = vlist . lines2PP . (map (token2PP ppNt ppProd field chids locals)) $ tks +-- hv_sp $ map (token2PP ppNt ppProd field chids locals) tks + + +{- +token2PP ppNt ppProd field chids locals tk + = case tk of + AGLocal var _ _ -> if (elem var locals) + then (ppListSep "(" "" "_" [pp var, ppNt, ppProd]) >|< pp " (loc # att_loc))" + else pp var + AGField field attr _ _ -> let ppChT = maybe (error $ "rhs field " ++ show field ++ " is not a child") ppShow (lookup field chids) + ppAtt = case (show field) of + "lhs" -> pp "att_inh" + "loc" -> pp "att_loc" + otherwise -> pp "att_syn" + ppSubAtt = case (show field) of + "lhs" -> ppListSep "" "" "_" [pp (getName attr), pp "Inh", ppNt] + "loc" -> ppListSep "" "" "_" [pp (getName attr), ppNt, ppProd] + otherwise -> ppListSep "" "" "_" [pp (getName attr), pp "Syn", ppChT] + in pp "(" >|< ppSubAtt >|< " (" >|< pp (getName field) >|< " # " >|< ppAtt >|< "))" + HsToken value _ -> pp value + CharToken value _ -> pp $ show value + StrToken value _ -> pp $ show value + Err mesg _ -> pp $ " ***" ++ mesg ++ "*** " +-} + +lines2PP [] = [] +lines2PP xs = map line2PP . shiftLeft . getLines $ xs + + +token2PP ppNt ppProd field chids locals tk + = case tk of + AGLocal var pos _ -> (pos, if (elem var locals) + then (ppListSep "(" "" "_" [pp var, ppNt, ppProd]) >|< pp " (loc # att_loc)) " + else pp var) + AGField field attr pos _ -> let ppChT = maybe (error $ "rhs field " ++ show field ++ " is not a child") ppShow (lookup field chids) + ppAtt = case (show field) of + "lhs" -> pp "att_inh" + "loc" -> pp "att_loc" + otherwise -> pp "att_syn" + ppSubAtt = case (show field) of + "lhs" -> ppListSep "" "" "_" [pp (getName attr), pp "Inh", ppNt] + "loc" -> ppListSep "" "" "_" [pp (getName attr), ppNt, ppProd] + otherwise -> ppListSep "" "" "_" [pp (getName attr), pp "Syn", ppChT] + in (pos, pp "(" >|< ppSubAtt >|< " (" >|< pp (getName field) >|< " # " >|< ppAtt >|< ")) ") + HsToken value pos -> (pos, pp value) + CharToken value pos -> (pos, pp $ show value) + StrToken value pos -> (pos, pp $ show value) + Err mesg pos -> (pos, pp $ " ***" ++ mesg ++ "*** ") + +line2PP ts = let f (p,t) r = let ct = column p + in \c -> pp (spaces (ct-c)) >|< t >|< r (length (show t) +ct) + spaces x | x < 0 = "" + | otherwise = replicate x ' ' + in foldr f (pp . const "") ts 1 + +{-# LINE 237 "../src-derived/AG2AspectAG.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + o_rename : Bool + ppNt : PP_Doc + ppProd : PP_Doc + synthesized attributes: + idCL : [(Identifier,Type)] + ppCSF : [(Identifier,PP_Doc)] + ppDL : [PP_Doc] + ppL : PP_Doc + ppR : PP_Doc + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _inh _syn _virtual ) = + (sem_Child_Child _name _tp _inh _syn _virtual ) +-- semantic domain +newtype T_Child = T_Child (Bool -> + PP_Doc -> + PP_Doc -> + ( ([(Identifier,Type)]),([(Identifier,PP_Doc)]),([PP_Doc]),PP_Doc,PP_Doc)) +data Inh_Child = Inh_Child {o_rename_Inh_Child :: Bool,ppNt_Inh_Child :: PP_Doc,ppProd_Inh_Child :: PP_Doc} +data Syn_Child = Syn_Child {idCL_Syn_Child :: ([(Identifier,Type)]),ppCSF_Syn_Child :: ([(Identifier,PP_Doc)]),ppDL_Syn_Child :: ([PP_Doc]),ppL_Syn_Child :: PP_Doc,ppR_Syn_Child :: PP_Doc} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem ) (Inh_Child _lhsIo_rename _lhsIppNt _lhsIppProd ) = + (let ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR) = sem _lhsIo_rename _lhsIppNt _lhsIppProd + in (Syn_Child _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppR )) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + (Maybe (Maybe Type)) -> + T_Child +sem_Child_Child name_ tp_ inh_ syn_ virtual_ = + (T_Child (\ _lhsIo_rename + _lhsIppNt + _lhsIppProd -> + (let _lhsOppDL :: ([PP_Doc]) + _lhsOppL :: PP_Doc + _lhsOppR :: PP_Doc + _lhsOidCL :: ([(Identifier,Type)]) + _lhsOppCSF :: ([(Identifier,PP_Doc)]) + -- "AG2AspectAG.ag"(line 129, column 25) + _lhsOppDL = + ({-# LINE 129 "AG2AspectAG.ag" #-} + case virtual_ of + Nothing -> let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd] + in [ chName >|< pp " :: " >|< ppShow tp_ ] + otherwise -> [] + {-# LINE 299 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 154, column 25) + _lhsOppL = + ({-# LINE 154 "AG2AspectAG.ag" #-} + let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd] + in pp "data Ch_" >|< chName >|< pp "; " >|< + pp "ch_" >|< chName >|< pp " = proxy :: " >|< + case virtual_ of + Nothing -> pp "Proxy " >|< pp "(Ch_" >|< chName >|< ", " >|< ppShow tp_ >|< pp ")" + otherwise -> pp "SemType " >|< ppShow tp_ >|< pp " nt => Proxy " >|< + pp "(Ch_" >|< chName >|< pp ", nt)" + {-# LINE 311 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 232, column 25) + _lhsOppR = + ({-# LINE 232 "AG2AspectAG.ag" #-} + let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd] + in pp name_ >|< " <- at ch_" >|< chName + {-# LINE 318 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 263, column 25) + _lhsOidCL = + ({-# LINE 263 "AG2AspectAG.ag" #-} + [ (name_, case (stripPrefix "T_" (show tp_)) of + Nothing -> tp_ + Just t -> NT (Ident t undefined) [] + ) ] + {-# LINE 327 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 468, column 25) + _lhsOppCSF = + ({-# LINE 468 "AG2AspectAG.ag" #-} + let + ppProd = ppListSep "" "" "_" [_lhsIppNt,_lhsIppProd] + ppChi = ppListSep "" "" "_" [pp "ch", pp name_, ppProd] + semC = if (isNonterminal tp_) + then pp "sem_" >|< ppShow tp_ >|< pp " _" >|< pp name_ + else pp "sem_Lit _" >|< pp name_ + in case virtual_ of + Nothing -> [(name_, ppChi >|< pp " .=. (" >|< semC >|< pp ") .*. ")] + otherwise -> [] + {-# LINE 341 "AG2AspectAG.hs" #-} + ) + in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR))) ) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + o_rename : Bool + ppNt : PP_Doc + ppProd : PP_Doc + synthesized attributes: + idCL : [(Identifier,Type)] + ppCSF : [(Identifier,PP_Doc)] + ppDL : [PP_Doc] + ppL : PP_Doc + ppR : PP_Doc + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) +-- semantic domain +newtype T_Children = T_Children (Bool -> + PP_Doc -> + PP_Doc -> + ( ([(Identifier,Type)]),([(Identifier,PP_Doc)]),([PP_Doc]),PP_Doc,PP_Doc)) +data Inh_Children = Inh_Children {o_rename_Inh_Children :: Bool,ppNt_Inh_Children :: PP_Doc,ppProd_Inh_Children :: PP_Doc} +data Syn_Children = Syn_Children {idCL_Syn_Children :: ([(Identifier,Type)]),ppCSF_Syn_Children :: ([(Identifier,PP_Doc)]),ppDL_Syn_Children :: ([PP_Doc]),ppL_Syn_Children :: PP_Doc,ppR_Syn_Children :: PP_Doc} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem ) (Inh_Children _lhsIo_rename _lhsIppNt _lhsIppProd ) = + (let ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR) = sem _lhsIo_rename _lhsIppNt _lhsIppProd + in (Syn_Children _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppR )) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = + (T_Children (\ _lhsIo_rename + _lhsIppNt + _lhsIppProd -> + (let _lhsOppDL :: ([PP_Doc]) + _lhsOidCL :: ([(Identifier,Type)]) + _lhsOppCSF :: ([(Identifier,PP_Doc)]) + _lhsOppL :: PP_Doc + _lhsOppR :: PP_Doc + _hdOo_rename :: Bool + _hdOppNt :: PP_Doc + _hdOppProd :: PP_Doc + _tlOo_rename :: Bool + _tlOppNt :: PP_Doc + _tlOppProd :: PP_Doc + _hdIidCL :: ([(Identifier,Type)]) + _hdIppCSF :: ([(Identifier,PP_Doc)]) + _hdIppDL :: ([PP_Doc]) + _hdIppL :: PP_Doc + _hdIppR :: PP_Doc + _tlIidCL :: ([(Identifier,Type)]) + _tlIppCSF :: ([(Identifier,PP_Doc)]) + _tlIppDL :: ([PP_Doc]) + _tlIppL :: PP_Doc + _tlIppR :: PP_Doc + -- "AG2AspectAG.ag"(line 125, column 33) + _lhsOppDL = + ({-# LINE 125 "AG2AspectAG.ag" #-} + _hdIppDL ++ _tlIppDL + {-# LINE 413 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 261, column 31) + _lhsOidCL = + ({-# LINE 261 "AG2AspectAG.ag" #-} + _hdIidCL ++ _tlIidCL + {-# LINE 419 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 464, column 34) + _lhsOppCSF = + ({-# LINE 464 "AG2AspectAG.ag" #-} + _hdIppCSF ++ _tlIppCSF + {-# LINE 425 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 146, column 79) + _lhsOppL = + ({-# LINE 146 "AG2AspectAG.ag" #-} + _hdIppL >-< _tlIppL + {-# LINE 431 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 220, column 79) + _lhsOppR = + ({-# LINE 220 "AG2AspectAG.ag" #-} + _hdIppR >-< _tlIppR + {-# LINE 437 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 38 "AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 443 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 449 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppProd = + ({-# LINE 82 "AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 455 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 38 "AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 461 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 467 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppProd = + ({-# LINE 82 "AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 473 "AG2AspectAG.hs" #-} + ) + ( _hdIidCL,_hdIppCSF,_hdIppDL,_hdIppL,_hdIppR) = + hd_ _hdOo_rename _hdOppNt _hdOppProd + ( _tlIidCL,_tlIppCSF,_tlIppDL,_tlIppL,_tlIppR) = + tl_ _tlOo_rename _tlOppNt _tlOppProd + in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR))) ) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ _lhsIo_rename + _lhsIppNt + _lhsIppProd -> + (let _lhsOppDL :: ([PP_Doc]) + _lhsOidCL :: ([(Identifier,Type)]) + _lhsOppCSF :: ([(Identifier,PP_Doc)]) + _lhsOppL :: PP_Doc + _lhsOppR :: PP_Doc + -- "AG2AspectAG.ag"(line 126, column 33) + _lhsOppDL = + ({-# LINE 126 "AG2AspectAG.ag" #-} + [] + {-# LINE 494 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 261, column 31) + _lhsOidCL = + ({-# LINE 261 "AG2AspectAG.ag" #-} + [] + {-# LINE 500 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 464, column 34) + _lhsOppCSF = + ({-# LINE 464 "AG2AspectAG.ag" #-} + [] + {-# LINE 506 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 146, column 79) + _lhsOppL = + ({-# LINE 146 "AG2AspectAG.ag" #-} + empty + {-# LINE 512 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 220, column 79) + _lhsOppR = + ({-# LINE 220 "AG2AspectAG.ag" #-} + empty + {-# LINE 518 "AG2AspectAG.hs" #-} + ) + in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR))) ) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + ppNt : PP_Doc + ppProd : PP_Doc + synthesized attribute: + ppRE : Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = T_Expression (PP_Doc -> + PP_Doc -> + ( (Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc))) +data Inh_Expression = Inh_Expression {ppNt_Inh_Expression :: PP_Doc,ppProd_Inh_Expression :: PP_Doc} +data Syn_Expression = Syn_Expression {ppRE_Syn_Expression :: (Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression _lhsIppNt _lhsIppProd ) = + (let ( _lhsOppRE) = sem _lhsIppNt _lhsIppProd + in (Syn_Expression _lhsOppRE )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (\ _lhsIppNt + _lhsIppProd -> + (let _lhsOppRE :: (Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) + -- "AG2AspectAG.ag"(line 257, column 25) + _lhsOppRE = + ({-# LINE 257 "AG2AspectAG.ag" #-} + rhsRule _lhsIppNt _lhsIppProd tks_ + {-# LINE 562 "AG2AspectAG.hs" #-} + ) + in ( _lhsOppRE))) ) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( PP_Doc)) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options} +data Syn_Grammar = Syn_Grammar {pp_Syn_Grammar :: PP_Doc} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) = + (let ( _lhsOpp) = sem _lhsIoptions + in (Syn_Grammar _lhsOpp )) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (\ _lhsIoptions -> + (let _nontsOo_rename :: Bool + _lhsOpp :: PP_Doc + _nontsOderivs :: Derivings + _nontsOtSyns :: TypeSyns + _nontsIppA :: PP_Doc + _nontsIppCata :: PP_Doc + _nontsIppD :: PP_Doc + _nontsIppL :: PP_Doc + _nontsIppNtL :: PP_Doc + _nontsIppR :: PP_Doc + _nontsIppSF :: PP_Doc + _nontsIppW :: PP_Doc + -- "AG2AspectAG.ag"(line 40, column 14) + _nontsOo_rename = + ({-# LINE 40 "AG2AspectAG.ag" #-} + rename _lhsIoptions + {-# LINE 638 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 47, column 25) + _lhsOpp = + ({-# LINE 47 "AG2AspectAG.ag" #-} + (if dataTypes _lhsIoptions + then pp "-- datatypes" >-< _nontsIppD >-< + pp "-- labels" >-< _nontsIppL + else empty) + >-< + (if folds _lhsIoptions + then pp "-- attributes" >-< defAtts >-< _nontsIppA >-< + pp "-- rules" >-< pp "listNt = " >|< _nontsIppNtL >-< _nontsIppR >-< + pp "-- catas" >-< _nontsIppCata + else empty) + >-< + (if semfuns _lhsIoptions + then pp "-- semantic functions" >-< _nontsIppSF + else empty) + >-< + (if wrappers _lhsIoptions + then pp "-- wrappers" >-< _nontsIppW + else empty) + {-# LINE 661 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 92, column 25) + _nontsOderivs = + ({-# LINE 92 "AG2AspectAG.ag" #-} + derivings_ + {-# LINE 667 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 138, column 34) + _nontsOtSyns = + ({-# LINE 138 "AG2AspectAG.ag" #-} + typeSyns_ + {-# LINE 673 "AG2AspectAG.hs" #-} + ) + ( _nontsIppA,_nontsIppCata,_nontsIppD,_nontsIppL,_nontsIppNtL,_nontsIppR,_nontsIppSF,_nontsIppW) = + nonts_ _nontsOderivs _nontsOo_rename _nontsOtSyns + in ( _lhsOpp))) ) +-- HsToken ----------------------------------------------------- +{- + alternatives: + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGField _field _attr _pos _rdesc ) = + (sem_HsToken_AGField _field _attr _pos _rdesc ) +sem_HsToken (AGLocal _var _pos _rdesc ) = + (sem_HsToken_AGLocal _var _pos _rdesc ) +sem_HsToken (CharToken _value _pos ) = + (sem_HsToken_CharToken _value _pos ) +sem_HsToken (Err _mesg _pos ) = + (sem_HsToken_Err _mesg _pos ) +sem_HsToken (HsToken _value _pos ) = + (sem_HsToken_HsToken _value _pos ) +sem_HsToken (StrToken _value _pos ) = + (sem_HsToken_StrToken _value _pos ) +-- semantic domain +newtype T_HsToken = T_HsToken (( )) +data Inh_HsToken = Inh_HsToken {} +data Syn_HsToken = Syn_HsToken {} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem ) (Inh_HsToken ) = + (let ( ) = sem + in (Syn_HsToken )) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (let + in ( )) ) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (let + in ( )) ) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (let + in ( )) ) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (let + in ( )) ) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (let + in ( )) ) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (let + in ( )) ) +-- HsTokens ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) ) +-- semantic domain +newtype T_HsTokens = T_HsTokens (( )) +data Inh_HsTokens = Inh_HsTokens {} +data Syn_HsTokens = Syn_HsTokens {} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens ) = + (let ( ) = sem + in (Syn_HsTokens )) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) = + (T_HsTokens (let + in ( )) ) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (let + in ( )) ) +-- HsTokensRoot ------------------------------------------------ +{- + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +-- cata +sem_HsTokensRoot :: HsTokensRoot -> + T_HsTokensRoot +sem_HsTokensRoot (HsTokensRoot _tokens ) = + (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens ) ) +-- semantic domain +newtype T_HsTokensRoot = T_HsTokensRoot (( )) +data Inh_HsTokensRoot = Inh_HsTokensRoot {} +data Syn_HsTokensRoot = Syn_HsTokensRoot {} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot ) = + (let ( ) = sem + in (Syn_HsTokensRoot )) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) = + (T_HsTokensRoot (let + in ( )) ) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + derivs : Derivings + o_rename : Bool + tSyns : TypeSyns + synthesized attributes: + ppA : PP_Doc + ppCata : PP_Doc + ppD : PP_Doc + ppL : PP_Doc + ppNtL : PP_Doc + ppR : PP_Doc + ppSF : PP_Doc + ppW : PP_Doc + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions +-} +-- cata +sem_Nonterminal :: Nonterminal -> + T_Nonterminal +sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods ) = + (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) +-- semantic domain +newtype T_Nonterminal = T_Nonterminal (Derivings -> + Bool -> + TypeSyns -> + ( PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc)) +data Inh_Nonterminal = Inh_Nonterminal {derivs_Inh_Nonterminal :: Derivings,o_rename_Inh_Nonterminal :: Bool,tSyns_Inh_Nonterminal :: TypeSyns} +data Syn_Nonterminal = Syn_Nonterminal {ppA_Syn_Nonterminal :: PP_Doc,ppCata_Syn_Nonterminal :: PP_Doc,ppD_Syn_Nonterminal :: PP_Doc,ppL_Syn_Nonterminal :: PP_Doc,ppNtL_Syn_Nonterminal :: PP_Doc,ppR_Syn_Nonterminal :: PP_Doc,ppSF_Syn_Nonterminal :: PP_Doc,ppW_Syn_Nonterminal :: PP_Doc} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIderivs _lhsIo_rename _lhsItSyns ) = + (let ( _lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW) = sem _lhsIderivs _lhsIo_rename _lhsItSyns + in (Syn_Nonterminal _lhsOppA _lhsOppCata _lhsOppD _lhsOppL _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW )) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = + (T_Nonterminal (\ _lhsIderivs + _lhsIo_rename + _lhsItSyns -> + (let _prodsOppNt :: PP_Doc + _lhsOppD :: PP_Doc + _lhsOppL :: PP_Doc + _lhsOppA :: PP_Doc + _lhsOppNtL :: PP_Doc + _lhsOppR :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppSF :: PP_Doc + _lhsOppW :: PP_Doc + _prodsOo_rename :: Bool + _prodsIppA :: PP_Doc + _prodsIppCata :: PP_Doc + _prodsIppDL :: ([PP_Doc]) + _prodsIppL :: PP_Doc + _prodsIppR :: PP_Doc + _prodsIppSF :: PP_Doc + -- "AG2AspectAG.ag"(line 79, column 25) + _prodsOppNt = + ({-# LINE 79 "AG2AspectAG.ag" #-} + pp nt_ + {-# LINE 898 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 98, column 25) + _lhsOppD = + ({-# LINE 98 "AG2AspectAG.ag" #-} + case (lookup nt_ _lhsItSyns) of + Nothing -> pp "data " >|< pp nt_ >|< " = " >|< vlist_sep " | " _prodsIppDL >-< + case (Map.lookup nt_ _lhsIderivs) of + Just ntds -> pp " deriving " >|< (ppListSep "(" ")" ", " $ Set.elems ntds) + Nothing -> empty + Just tp -> pp "type " >|< pp nt_ >|< " = " >|< ppShow tp + {-# LINE 909 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 149, column 25) + _lhsOppL = + ({-# LINE 149 "AG2AspectAG.ag" #-} + pp "nt_" >|< pp nt_ >|< " = proxy :: Proxy " >|< pp nt_ >-< + _prodsIppL + {-# LINE 916 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 171, column 25) + _lhsOppA = + ({-# LINE 171 "AG2AspectAG.ag" #-} + defTAtt "inh" (pp nt_) inh_ >-< + defTAtt "syn" (pp nt_) syn_ >-< + _prodsIppA + {-# LINE 924 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 216, column 25) + _lhsOppNtL = + ({-# LINE 216 "AG2AspectAG.ag" #-} + pp "nt_" >|< pp nt_ >|< pp " .*. " + {-# LINE 930 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 223, column 25) + _lhsOppR = + ({-# LINE 223 "AG2AspectAG.ag" #-} + pp "----" >|< pp nt_ >-< _prodsIppR + {-# LINE 936 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 417, column 25) + _lhsOppCata = + ({-# LINE 417 "AG2AspectAG.ag" #-} + let ppNt = pp nt_ + in pp "----" >|< ppNt >-< + _prodsIppCata + {-# LINE 944 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 438, column 25) + _lhsOppSF = + ({-# LINE 438 "AG2AspectAG.ag" #-} + let ppNt = pp nt_ + in pp "----" >|< ppNt >-< + pp "type T_" >|< ppNt >|< pp " = " >|< + pp "(Record (HCons (LVPair (Proxy Att_inh) Inh_" >|< ppNt >|< pp ") HNil)) -> " >|< + pp "(Record (HCons (LVPair (Proxy Att_syn) Syn_" >|< ppNt >|< pp ") HNil))" >-< + pp "instance SemType T_" >|< ppNt >|< pp " " >|< ppNt >-< + pp "-- sem_" >|< ppNt >|< pp " :: " >|< ppNt >|< pp " -> T_" >|< ppNt >-< + _prodsIppSF + {-# LINE 957 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 485, column 25) + _lhsOppW = + ({-# LINE 485 "AG2AspectAG.ag" #-} + pp "wrap_" >|< pp nt_ >|< pp " sem _inh = " >-< + pp " let (Record (HCons _syn HNil)) = sem (att_inh .=. _inh .*. emptyRecord)" >|< + pp " in (valueLVPair _syn)" + {-# LINE 965 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _prodsOo_rename = + ({-# LINE 38 "AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 971 "AG2AspectAG.hs" #-} + ) + ( _prodsIppA,_prodsIppCata,_prodsIppDL,_prodsIppL,_prodsIppR,_prodsIppSF) = + prods_ _prodsOo_rename _prodsOppNt + in ( _lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW))) ) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + derivs : Derivings + o_rename : Bool + tSyns : TypeSyns + synthesized attributes: + ppA : PP_Doc + ppCata : PP_Doc + ppD : PP_Doc + ppL : PP_Doc + ppNtL : PP_Doc + ppR : PP_Doc + ppSF : PP_Doc + ppW : PP_Doc + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals (Derivings -> + Bool -> + TypeSyns -> + ( PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc)) +data Inh_Nonterminals = Inh_Nonterminals {derivs_Inh_Nonterminals :: Derivings,o_rename_Inh_Nonterminals :: Bool,tSyns_Inh_Nonterminals :: TypeSyns} +data Syn_Nonterminals = Syn_Nonterminals {ppA_Syn_Nonterminals :: PP_Doc,ppCata_Syn_Nonterminals :: PP_Doc,ppD_Syn_Nonterminals :: PP_Doc,ppL_Syn_Nonterminals :: PP_Doc,ppNtL_Syn_Nonterminals :: PP_Doc,ppR_Syn_Nonterminals :: PP_Doc,ppSF_Syn_Nonterminals :: PP_Doc,ppW_Syn_Nonterminals :: PP_Doc} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIderivs _lhsIo_rename _lhsItSyns ) = + (let ( _lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW) = sem _lhsIderivs _lhsIo_rename _lhsItSyns + in (Syn_Nonterminals _lhsOppA _lhsOppCata _lhsOppD _lhsOppL _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW )) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = + (T_Nonterminals (\ _lhsIderivs + _lhsIo_rename + _lhsItSyns -> + (let _lhsOppA :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppD :: PP_Doc + _lhsOppL :: PP_Doc + _lhsOppNtL :: PP_Doc + _lhsOppR :: PP_Doc + _lhsOppSF :: PP_Doc + _lhsOppW :: PP_Doc + _hdOderivs :: Derivings + _hdOo_rename :: Bool + _hdOtSyns :: TypeSyns + _tlOderivs :: Derivings + _tlOo_rename :: Bool + _tlOtSyns :: TypeSyns + _hdIppA :: PP_Doc + _hdIppCata :: PP_Doc + _hdIppD :: PP_Doc + _hdIppL :: PP_Doc + _hdIppNtL :: PP_Doc + _hdIppR :: PP_Doc + _hdIppSF :: PP_Doc + _hdIppW :: PP_Doc + _tlIppA :: PP_Doc + _tlIppCata :: PP_Doc + _tlIppD :: PP_Doc + _tlIppL :: PP_Doc + _tlIppNtL :: PP_Doc + _tlIppR :: PP_Doc + _tlIppSF :: PP_Doc + _tlIppW :: PP_Doc + -- use rule "AG2AspectAG.ag"(line 168, column 64) + _lhsOppA = + ({-# LINE 168 "AG2AspectAG.ag" #-} + _hdIppA >-< _tlIppA + {-# LINE 1057 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 414, column 67) + _lhsOppCata = + ({-# LINE 414 "AG2AspectAG.ag" #-} + _hdIppCata >-< _tlIppCata + {-# LINE 1063 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 95, column 52) + _lhsOppD = + ({-# LINE 95 "AG2AspectAG.ag" #-} + _hdIppD >-< _tlIppD + {-# LINE 1069 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 146, column 79) + _lhsOppL = + ({-# LINE 146 "AG2AspectAG.ag" #-} + _hdIppL >-< _tlIppL + {-# LINE 1075 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 213, column 44) + _lhsOppNtL = + ({-# LINE 213 "AG2AspectAG.ag" #-} + _hdIppNtL >|< _tlIppNtL + {-# LINE 1081 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 220, column 79) + _lhsOppR = + ({-# LINE 220 "AG2AspectAG.ag" #-} + _hdIppR >-< _tlIppR + {-# LINE 1087 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 435, column 66) + _lhsOppSF = + ({-# LINE 435 "AG2AspectAG.ag" #-} + _hdIppSF >-< _tlIppSF + {-# LINE 1093 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 482, column 42) + _lhsOppW = + ({-# LINE 482 "AG2AspectAG.ag" #-} + _hdIppW >-< _tlIppW + {-# LINE 1099 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOderivs = + ({-# LINE 89 "AG2AspectAG.ag" #-} + _lhsIderivs + {-# LINE 1105 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 38 "AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 1111 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOtSyns = + ({-# LINE 135 "AG2AspectAG.ag" #-} + _lhsItSyns + {-# LINE 1117 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOderivs = + ({-# LINE 89 "AG2AspectAG.ag" #-} + _lhsIderivs + {-# LINE 1123 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 38 "AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 1129 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOtSyns = + ({-# LINE 135 "AG2AspectAG.ag" #-} + _lhsItSyns + {-# LINE 1135 "AG2AspectAG.hs" #-} + ) + ( _hdIppA,_hdIppCata,_hdIppD,_hdIppL,_hdIppNtL,_hdIppR,_hdIppSF,_hdIppW) = + hd_ _hdOderivs _hdOo_rename _hdOtSyns + ( _tlIppA,_tlIppCata,_tlIppD,_tlIppL,_tlIppNtL,_tlIppR,_tlIppSF,_tlIppW) = + tl_ _tlOderivs _tlOo_rename _tlOtSyns + in ( _lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW))) ) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ _lhsIderivs + _lhsIo_rename + _lhsItSyns -> + (let _lhsOppA :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppD :: PP_Doc + _lhsOppL :: PP_Doc + _lhsOppNtL :: PP_Doc + _lhsOppR :: PP_Doc + _lhsOppSF :: PP_Doc + _lhsOppW :: PP_Doc + -- use rule "AG2AspectAG.ag"(line 168, column 64) + _lhsOppA = + ({-# LINE 168 "AG2AspectAG.ag" #-} + empty + {-# LINE 1159 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 414, column 67) + _lhsOppCata = + ({-# LINE 414 "AG2AspectAG.ag" #-} + empty + {-# LINE 1165 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 95, column 52) + _lhsOppD = + ({-# LINE 95 "AG2AspectAG.ag" #-} + empty + {-# LINE 1171 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 146, column 79) + _lhsOppL = + ({-# LINE 146 "AG2AspectAG.ag" #-} + empty + {-# LINE 1177 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 213, column 44) + _lhsOppNtL = + ({-# LINE 213 "AG2AspectAG.ag" #-} + pp "hNil" + {-# LINE 1183 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 220, column 79) + _lhsOppR = + ({-# LINE 220 "AG2AspectAG.ag" #-} + empty + {-# LINE 1189 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 435, column 66) + _lhsOppSF = + ({-# LINE 435 "AG2AspectAG.ag" #-} + empty + {-# LINE 1195 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 482, column 42) + _lhsOppW = + ({-# LINE 482 "AG2AspectAG.ag" #-} + empty + {-# LINE 1201 "AG2AspectAG.hs" #-} + ) + in ( _lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW))) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + info : (Identifier, Identifier) + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern ,((Identifier, Identifier)))) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern ,info_Syn_Pattern :: ((Identifier, Identifier))} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOcopy,_lhsOinfo) = sem + in (Syn_Pattern _lhsOcopy _lhsOinfo )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIinfo :: ((Identifier, Identifier)) + _partsIcopy :: Patterns + -- "AG2AspectAG.ag"(line 240, column 25) + _lhsOinfo = + ({-# LINE 240 "AG2AspectAG.ag" #-} + (field_, attr_) + {-# LINE 1275 "AG2AspectAG.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 1281 "AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1287 "AG2AspectAG.hs" #-} + ) + ( _patIcopy,_patIinfo) = + pat_ + ( _partsIcopy) = + parts_ + in ( _lhsOcopy,_lhsOinfo)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + -- "AG2AspectAG.ag"(line 241, column 25) + _lhsOinfo = + ({-# LINE 241 "AG2AspectAG.ag" #-} + error "Pattern Constr undefined!!" + {-# LINE 1305 "AG2AspectAG.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1311 "AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1317 "AG2AspectAG.hs" #-} + ) + ( _patsIcopy) = + pats_ + in ( _lhsOcopy,_lhsOinfo)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOcopy :: Pattern + _lhsOinfo :: ((Identifier, Identifier)) + _patIcopy :: Pattern + _patIinfo :: ((Identifier, Identifier)) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1333 "AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1339 "AG2AspectAG.hs" #-} + ) + -- copy rule (up) + _lhsOinfo = + ({-# LINE 238 "AG2AspectAG.ag" #-} + _patIinfo + {-# LINE 1345 "AG2AspectAG.hs" #-} + ) + ( _patIcopy,_patIinfo) = + pat_ + in ( _lhsOcopy,_lhsOinfo)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + -- "AG2AspectAG.ag"(line 242, column 25) + _lhsOinfo = + ({-# LINE 242 "AG2AspectAG.ag" #-} + error "Pattern Product undefined!!" + {-# LINE 1361 "AG2AspectAG.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1367 "AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1373 "AG2AspectAG.hs" #-} + ) + ( _patsIcopy) = + pats_ + in ( _lhsOcopy,_lhsOinfo)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) + _lhsOcopy :: Pattern + -- "AG2AspectAG.ag"(line 243, column 25) + _lhsOinfo = + ({-# LINE 243 "AG2AspectAG.ag" #-} + error "Pattern Underscore undefined!!" + {-# LINE 1387 "AG2AspectAG.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 1393 "AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1399 "AG2AspectAG.hs" #-} + ) + in ( _lhsOcopy,_lhsOinfo)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : SELF + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( Patterns )) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns } +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOcopy) = sem + in (Syn_Patterns _lhsOcopy )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIinfo :: ((Identifier, Identifier)) + _tlIcopy :: Patterns + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1444 "AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1450 "AG2AspectAG.hs" #-} + ) + ( _hdIcopy,_hdIinfo) = + hd_ + ( _tlIcopy) = + tl_ + in ( _lhsOcopy)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOcopy :: Patterns + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 1464 "AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1470 "AG2AspectAG.hs" #-} + ) + in ( _lhsOcopy)) ) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + o_rename : Bool + ppNt : PP_Doc + synthesized attributes: + ppA : PP_Doc + ppCata : PP_Doc + ppD : PP_Doc + ppL : PP_Doc + ppR : PP_Doc + ppSF : PP_Doc + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _children _rules _typeSigs ) = + (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) +-- semantic domain +newtype T_Production = T_Production (Bool -> + PP_Doc -> + ( PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc)) +data Inh_Production = Inh_Production {o_rename_Inh_Production :: Bool,ppNt_Inh_Production :: PP_Doc} +data Syn_Production = Syn_Production {ppA_Syn_Production :: PP_Doc,ppCata_Syn_Production :: PP_Doc,ppD_Syn_Production :: PP_Doc,ppL_Syn_Production :: PP_Doc,ppR_Syn_Production :: PP_Doc,ppSF_Syn_Production :: PP_Doc} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem ) (Inh_Production _lhsIo_rename _lhsIppNt ) = + (let ( _lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppL,_lhsOppR,_lhsOppSF) = sem _lhsIo_rename _lhsIppNt + in (Syn_Production _lhsOppA _lhsOppCata _lhsOppD _lhsOppL _lhsOppR _lhsOppSF )) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = + (T_Production (\ _lhsIo_rename + _lhsIppNt -> + (let _childrenOppProd :: PP_Doc + _rulesOppProd :: PP_Doc + _lhsOppD :: PP_Doc + _lhsOppA :: PP_Doc + _lhsOppR :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppSF :: PP_Doc + _lhsOppL :: PP_Doc + _childrenOo_rename :: Bool + _childrenOppNt :: PP_Doc + _rulesOppNt :: PP_Doc + _childrenIidCL :: ([(Identifier,Type)]) + _childrenIppCSF :: ([(Identifier,PP_Doc)]) + _childrenIppDL :: ([PP_Doc]) + _childrenIppL :: PP_Doc + _childrenIppR :: PP_Doc + _rulesIlocals :: ([Identifier]) + _rulesIppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]) + -- "AG2AspectAG.ag"(line 85, column 25) + _childrenOppProd = + ({-# LINE 85 "AG2AspectAG.ag" #-} + pp con_ + {-# LINE 1540 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 86, column 25) + _rulesOppProd = + ({-# LINE 86 "AG2AspectAG.ag" #-} + pp con_ + {-# LINE 1546 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 107, column 25) + _lhsOppD = + ({-# LINE 107 "AG2AspectAG.ag" #-} + let ppProd = prodName _lhsIo_rename _lhsIppNt (pp con_) + in ppProd >|< ppListSep " {" "}" ", " _childrenIppDL + {-# LINE 1553 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 176, column 25) + _lhsOppA = + ({-# LINE 176 "AG2AspectAG.ag" #-} + defLocalAtts _lhsIppNt (pp con_) (length _rulesIlocals) 1 $ sort _rulesIlocals + {-# LINE 1559 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 226, column 25) + _lhsOppR = + ({-# LINE 226 "AG2AspectAG.ag" #-} + defInstRules _lhsIppNt con_ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals >-< + defLocRule _lhsIppNt con_ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals >-< + defInhRule _lhsIppNt con_ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals >-< + defSynRule _lhsIppNt con_ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals + {-# LINE 1568 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 424, column 25) + _lhsOppCata = + ({-# LINE 424 "AG2AspectAG.ag" #-} + let ppProd = ppListSep "" "" "_" [_lhsIppNt, pp con_] + in pp "asp_" >|< ppProd >|< pp " = inh_" >|< ppProd >|< + pp " `ext` syn_" >|< ppProd >|< + pp " `ext` loc_" >|< ppProd >|< + pp " `ext` inst_" >|< ppProd >-< + pp "sem_" >|< ppProd >|< pp " = knit asp_" >|< ppProd + {-# LINE 1579 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 449, column 25) + _lhsOppSF = + ({-# LINE 449 "AG2AspectAG.ag" #-} + let chi = _childrenIppCSF + ppProd = ppListSep "" "" "_" [_lhsIppNt,pp con_] + ppPattern = case (show con_) of + "Cons" -> ppParams (ppListSep "" "" " : ") + "Nil" -> pp "[]" + otherwise -> prodName _lhsIo_rename _lhsIppNt (pp con_) >|< pp " " >|< (ppParams ppSpaced) + ppParams f = f $ map (((>|<) (pp "_")) . fst) chi + in pp "sem_" >|< _lhsIppNt >|< pp " (" >|< ppPattern >|< ") = sem_" >|< ppProd >|< + pp " (" >|< map snd chi >|< pp "emptyRecord)" + {-# LINE 1593 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 146, column 79) + _lhsOppL = + ({-# LINE 146 "AG2AspectAG.ag" #-} + _childrenIppL + {-# LINE 1599 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOo_rename = + ({-# LINE 38 "AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 1605 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 1611 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rulesOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 1617 "AG2AspectAG.hs" #-} + ) + ( _childrenIidCL,_childrenIppCSF,_childrenIppDL,_childrenIppL,_childrenIppR) = + children_ _childrenOo_rename _childrenOppNt _childrenOppProd + ( _rulesIlocals,_rulesIppRL) = + rules_ _rulesOppNt _rulesOppProd + in ( _lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppL,_lhsOppR,_lhsOppSF))) ) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + o_rename : Bool + ppNt : PP_Doc + synthesized attributes: + ppA : PP_Doc + ppCata : PP_Doc + ppDL : [PP_Doc] + ppL : PP_Doc + ppR : PP_Doc + ppSF : PP_Doc + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) +-- semantic domain +newtype T_Productions = T_Productions (Bool -> + PP_Doc -> + ( PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,PP_Doc,PP_Doc)) +data Inh_Productions = Inh_Productions {o_rename_Inh_Productions :: Bool,ppNt_Inh_Productions :: PP_Doc} +data Syn_Productions = Syn_Productions {ppA_Syn_Productions :: PP_Doc,ppCata_Syn_Productions :: PP_Doc,ppDL_Syn_Productions :: ([PP_Doc]),ppL_Syn_Productions :: PP_Doc,ppR_Syn_Productions :: PP_Doc,ppSF_Syn_Productions :: PP_Doc} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem ) (Inh_Productions _lhsIo_rename _lhsIppNt ) = + (let ( _lhsOppA,_lhsOppCata,_lhsOppDL,_lhsOppL,_lhsOppR,_lhsOppSF) = sem _lhsIo_rename _lhsIppNt + in (Syn_Productions _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppR _lhsOppSF )) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = + (T_Productions (\ _lhsIo_rename + _lhsIppNt -> + (let _lhsOppDL :: ([PP_Doc]) + _lhsOppA :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppL :: PP_Doc + _lhsOppR :: PP_Doc + _lhsOppSF :: PP_Doc + _hdOo_rename :: Bool + _hdOppNt :: PP_Doc + _tlOo_rename :: Bool + _tlOppNt :: PP_Doc + _hdIppA :: PP_Doc + _hdIppCata :: PP_Doc + _hdIppD :: PP_Doc + _hdIppL :: PP_Doc + _hdIppR :: PP_Doc + _hdIppSF :: PP_Doc + _tlIppA :: PP_Doc + _tlIppCata :: PP_Doc + _tlIppDL :: ([PP_Doc]) + _tlIppL :: PP_Doc + _tlIppR :: PP_Doc + _tlIppSF :: PP_Doc + -- "AG2AspectAG.ag"(line 121, column 33) + _lhsOppDL = + ({-# LINE 121 "AG2AspectAG.ag" #-} + _hdIppD : _tlIppDL + {-# LINE 1692 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 168, column 64) + _lhsOppA = + ({-# LINE 168 "AG2AspectAG.ag" #-} + _hdIppA >-< _tlIppA + {-# LINE 1698 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 414, column 67) + _lhsOppCata = + ({-# LINE 414 "AG2AspectAG.ag" #-} + _hdIppCata >-< _tlIppCata + {-# LINE 1704 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 146, column 79) + _lhsOppL = + ({-# LINE 146 "AG2AspectAG.ag" #-} + _hdIppL >-< _tlIppL + {-# LINE 1710 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 220, column 79) + _lhsOppR = + ({-# LINE 220 "AG2AspectAG.ag" #-} + _hdIppR >-< _tlIppR + {-# LINE 1716 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 435, column 66) + _lhsOppSF = + ({-# LINE 435 "AG2AspectAG.ag" #-} + _hdIppSF >-< _tlIppSF + {-# LINE 1722 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 38 "AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 1728 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 1734 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 38 "AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 1740 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 1746 "AG2AspectAG.hs" #-} + ) + ( _hdIppA,_hdIppCata,_hdIppD,_hdIppL,_hdIppR,_hdIppSF) = + hd_ _hdOo_rename _hdOppNt + ( _tlIppA,_tlIppCata,_tlIppDL,_tlIppL,_tlIppR,_tlIppSF) = + tl_ _tlOo_rename _tlOppNt + in ( _lhsOppA,_lhsOppCata,_lhsOppDL,_lhsOppL,_lhsOppR,_lhsOppSF))) ) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ _lhsIo_rename + _lhsIppNt -> + (let _lhsOppDL :: ([PP_Doc]) + _lhsOppA :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppL :: PP_Doc + _lhsOppR :: PP_Doc + _lhsOppSF :: PP_Doc + -- "AG2AspectAG.ag"(line 122, column 33) + _lhsOppDL = + ({-# LINE 122 "AG2AspectAG.ag" #-} + [] + {-# LINE 1767 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 168, column 64) + _lhsOppA = + ({-# LINE 168 "AG2AspectAG.ag" #-} + empty + {-# LINE 1773 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 414, column 67) + _lhsOppCata = + ({-# LINE 414 "AG2AspectAG.ag" #-} + empty + {-# LINE 1779 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 146, column 79) + _lhsOppL = + ({-# LINE 146 "AG2AspectAG.ag" #-} + empty + {-# LINE 1785 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 220, column 79) + _lhsOppR = + ({-# LINE 220 "AG2AspectAG.ag" #-} + empty + {-# LINE 1791 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 435, column 66) + _lhsOppSF = + ({-# LINE 435 "AG2AspectAG.ag" #-} + empty + {-# LINE 1797 "AG2AspectAG.hs" #-} + ) + in ( _lhsOppA,_lhsOppCata,_lhsOppDL,_lhsOppL,_lhsOppR,_lhsOppSF))) ) +-- Rule -------------------------------------------------------- +{- + visit 0: + inherited attributes: + ppNt : PP_Doc + ppProd : PP_Doc + synthesized attributes: + locals : [Identifier] + ppRL : [((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)] + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) +-- semantic domain +newtype T_Rule = T_Rule (PP_Doc -> + PP_Doc -> + ( ([Identifier]),([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]))) +data Inh_Rule = Inh_Rule {ppNt_Inh_Rule :: PP_Doc,ppProd_Inh_Rule :: PP_Doc} +data Syn_Rule = Syn_Rule {locals_Syn_Rule :: ([Identifier]),ppRL_Syn_Rule :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIppNt _lhsIppProd ) = + (let ( _lhsOlocals,_lhsOppRL) = sem _lhsIppNt _lhsIppProd + in (Syn_Rule _lhsOlocals _lhsOppRL )) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = + (T_Rule (\ _lhsIppNt + _lhsIppProd -> + (let _lhsOlocals :: ([Identifier]) + _lhsOppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]) + _rhsOppNt :: PP_Doc + _rhsOppProd :: PP_Doc + _patternIcopy :: Pattern + _patternIinfo :: ((Identifier, Identifier)) + _rhsIppRE :: (Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) + -- "AG2AspectAG.ag"(line 206, column 25) + _lhsOlocals = + ({-# LINE 206 "AG2AspectAG.ag" #-} + if (show (fst _patternIinfo) == "loc") + then [ snd _patternIinfo ] + else [ ] + {-# LINE 1858 "AG2AspectAG.hs" #-} + ) + -- "AG2AspectAG.ag"(line 253, column 33) + _lhsOppRL = + ({-# LINE 253 "AG2AspectAG.ag" #-} + [ (_patternIinfo, defRule _lhsIppNt _patternIinfo _rhsIppRE) ] + {-# LINE 1864 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rhsOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 1870 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rhsOppProd = + ({-# LINE 82 "AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 1876 "AG2AspectAG.hs" #-} + ) + ( _patternIcopy,_patternIinfo) = + pattern_ + ( _rhsIppRE) = + rhs_ _rhsOppNt _rhsOppProd + in ( _lhsOlocals,_lhsOppRL))) ) +-- Rules ------------------------------------------------------- +{- + visit 0: + inherited attributes: + ppNt : PP_Doc + ppProd : PP_Doc + synthesized attributes: + locals : [Identifier] + ppRL : [((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)] + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) +-- semantic domain +newtype T_Rules = T_Rules (PP_Doc -> + PP_Doc -> + ( ([Identifier]),([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]))) +data Inh_Rules = Inh_Rules {ppNt_Inh_Rules :: PP_Doc,ppProd_Inh_Rules :: PP_Doc} +data Syn_Rules = Syn_Rules {locals_Syn_Rules :: ([Identifier]),ppRL_Syn_Rules :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIppNt _lhsIppProd ) = + (let ( _lhsOlocals,_lhsOppRL) = sem _lhsIppNt _lhsIppProd + in (Syn_Rules _lhsOlocals _lhsOppRL )) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) = + (T_Rules (\ _lhsIppNt + _lhsIppProd -> + (let _lhsOppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]) + _lhsOlocals :: ([Identifier]) + _hdOppNt :: PP_Doc + _hdOppProd :: PP_Doc + _tlOppNt :: PP_Doc + _tlOppProd :: PP_Doc + _hdIlocals :: ([Identifier]) + _hdIppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]) + _tlIlocals :: ([Identifier]) + _tlIppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]) + -- "AG2AspectAG.ag"(line 249, column 33) + _lhsOppRL = + ({-# LINE 249 "AG2AspectAG.ag" #-} + _hdIppRL ++ _tlIppRL + {-# LINE 1935 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 202, column 30) + _lhsOlocals = + ({-# LINE 202 "AG2AspectAG.ag" #-} + _hdIlocals ++ _tlIlocals + {-# LINE 1941 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 1947 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppProd = + ({-# LINE 82 "AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 1953 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppNt = + ({-# LINE 76 "AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 1959 "AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppProd = + ({-# LINE 82 "AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 1965 "AG2AspectAG.hs" #-} + ) + ( _hdIlocals,_hdIppRL) = + hd_ _hdOppNt _hdOppProd + ( _tlIlocals,_tlIppRL) = + tl_ _tlOppNt _tlOppProd + in ( _lhsOlocals,_lhsOppRL))) ) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ _lhsIppNt + _lhsIppProd -> + (let _lhsOppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]) + _lhsOlocals :: ([Identifier]) + -- "AG2AspectAG.ag"(line 250, column 33) + _lhsOppRL = + ({-# LINE 250 "AG2AspectAG.ag" #-} + [] + {-# LINE 1982 "AG2AspectAG.hs" #-} + ) + -- use rule "AG2AspectAG.ag"(line 202, column 30) + _lhsOlocals = + ({-# LINE 202 "AG2AspectAG.ag" #-} + [] + {-# LINE 1988 "AG2AspectAG.hs" #-} + ) + in ( _lhsOlocals,_lhsOppRL))) ) +-- TypeSig ----------------------------------------------------- +{- + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp ) = + (sem_TypeSig_TypeSig _name _tp ) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( )) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) = + (let ( ) = sem + in (Syn_TypeSig )) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let + in ( )) ) +-- TypeSigs ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( )) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) = + (let ( ) = sem + in (Syn_TypeSigs )) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) = + (T_TypeSigs (let + in ( )) ) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let + in ( )) ) diff --git a/src-derived/AbstractSyntax.hs b/src-derived/AbstractSyntax.hs new file mode 100644 --- /dev/null +++ b/src-derived/AbstractSyntax.hs @@ -0,0 +1,130 @@ + + +-- UUAGC 0.9.38.1 (AbstractSyntax.ag) +module AbstractSyntax where +{-# LINE 2 "AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 14 "../src-derived/AbstractSyntax.hs" #-} +-- Child ------------------------------------------------------- +{- + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} +-} +data Child = Child (Identifier) (Type) (Attributes) (Attributes) ((Maybe (Maybe Type))) +-- Children ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +type Children = [Child ] +-- Grammar ----------------------------------------------------- +{- + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) ((Set NontermIdent)) (Nonterminals ) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) (QuantMap) (UniqueMap) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))))) +-- Nonterminal ------------------------------------------------- +{- + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions +-} +data Nonterminal = Nonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (Productions ) +-- Nonterminals ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +type Nonterminals = [Nonterminal ] +-- Production -------------------------------------------------- +{- + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs +-} +data Production = Production (ConstructorIdent) (Children ) (Rules ) (TypeSigs ) +-- Productions ------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +type Productions = [Production ] +-- Rule -------------------------------------------------------- +{- + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : {Pattern} + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} +-} +data Rule = Rule ((Maybe Identifier)) (Pattern) (Expression) (Bool) (String) (Bool) +-- Rules ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +type Rules = [Rule ] +-- TypeSig ----------------------------------------------------- +{- + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +data TypeSig = TypeSig (Identifier) (Type) +-- TypeSigs ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +type TypeSigs = [TypeSig ] diff --git a/src-derived/AbstractSyntaxDump.hs b/src-derived/AbstractSyntaxDump.hs new file mode 100644 --- /dev/null +++ b/src-derived/AbstractSyntaxDump.hs @@ -0,0 +1,1035 @@ + + +-- UUAGC 0.9.38.1 (AbstractSyntaxDump.ag) +module AbstractSyntaxDump where +{-# LINE 6 "AbstractSyntaxDump.ag" #-} + +import Data.List +import qualified Data.Map as Map + +import Pretty +import PPUtil + +import AbstractSyntax +import TokenDef +{-# LINE 16 "../src-derived/AbstractSyntaxDump.hs" #-} + +{-# LINE 2 "./AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 26 "../src-derived/AbstractSyntaxDump.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 33 "../src-derived/AbstractSyntaxDump.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 39 "../src-derived/AbstractSyntaxDump.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _inh _syn _virtual ) = + (sem_Child_Child _name _tp _inh _syn _virtual ) +-- semantic domain +newtype T_Child = T_Child (( PP_Doc)) +data Inh_Child = Inh_Child {} +data Syn_Child = Syn_Child {pp_Syn_Child :: PP_Doc} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem ) (Inh_Child ) = + (let ( _lhsOpp) = sem + in (Syn_Child _lhsOpp )) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + (Maybe (Maybe Type)) -> + T_Child +sem_Child_Child name_ tp_ inh_ syn_ virtual_ = + (T_Child (let _lhsOpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 35, column 33) + _lhsOpp = + ({-# LINE 35 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] [] + {-# LINE 80 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp)) ) +-- Children ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) +-- semantic domain +newtype T_Children = T_Children (( PP_Doc,([PP_Doc]))) +data Inh_Children = Inh_Children {} +data Syn_Children = Syn_Children {pp_Syn_Children :: PP_Doc,ppL_Syn_Children :: ([PP_Doc])} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem ) (Inh_Children ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_Children _lhsOpp _lhsOppL )) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = + (T_Children (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 67, column 33) + _lhsOppL = + ({-# LINE 67 "AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 123 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 129 "AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 68, column 33) + _lhsOppL = + ({-# LINE 68 "AbstractSyntaxDump.ag" #-} + [] + {-# LINE 144 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + empty + {-# LINE 150 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = T_Expression (( PP_Doc)) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {pp_Syn_Expression :: PP_Doc} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression ) = + (let ( _lhsOpp) = sem + in (Syn_Expression _lhsOpp )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 50, column 25) + _lhsOpp = + ({-# LINE 50 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] [] + {-# LINE 187 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp)) ) +-- Grammar ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) +-- semantic domain +newtype T_Grammar = T_Grammar (( PP_Doc)) +data Inh_Grammar = Inh_Grammar {} +data Syn_Grammar = Syn_Grammar {pp_Syn_Grammar :: PP_Doc} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem ) (Inh_Grammar ) = + (let ( _lhsOpp) = sem + in (Syn_Grammar _lhsOpp )) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (let _lhsOpp :: PP_Doc + _nontsIpp :: PP_Doc + _nontsIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 20, column 25) + _lhsOpp = + ({-# LINE 20 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Grammar","Grammar"] [] + [ ppF "typeSyns" $ ppAssocL typeSyns_ + , ppF "useMap" $ ppMap $ Map.map ppMap $ useMap_ + , ppF "derivings" $ ppMap $ derivings_ + , ppF "wrappers" $ ppShow $ wrappers_ + , ppF "nonts" $ ppVList _nontsIppL + ] [] + {-# LINE 256 "AbstractSyntaxDump.hs" #-} + ) + ( _nontsIpp,_nontsIppL) = + nonts_ + in ( _lhsOpp)) ) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions +-} +-- cata +sem_Nonterminal :: Nonterminal -> + T_Nonterminal +sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods ) = + (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) +-- semantic domain +newtype T_Nonterminal = T_Nonterminal (( PP_Doc)) +data Inh_Nonterminal = Inh_Nonterminal {} +data Syn_Nonterminal = Syn_Nonterminal {pp_Syn_Nonterminal :: PP_Doc} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal ) = + (let ( _lhsOpp) = sem + in (Syn_Nonterminal _lhsOpp )) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = + (T_Nonterminal (let _lhsOpp :: PP_Doc + _prodsIpp :: PP_Doc + _prodsIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 29, column 25) + _lhsOpp = + ({-# LINE 29 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Nonterminal","Nonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL] [] + {-# LINE 303 "AbstractSyntaxDump.hs" #-} + ) + ( _prodsIpp,_prodsIppL) = + prods_ + in ( _lhsOpp)) ) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals (( PP_Doc,([PP_Doc]))) +data Inh_Nonterminals = Inh_Nonterminals {} +data Syn_Nonterminals = Syn_Nonterminals {pp_Syn_Nonterminals :: PP_Doc,ppL_Syn_Nonterminals :: ([PP_Doc])} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_Nonterminals _lhsOpp _lhsOppL )) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = + (T_Nonterminals (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 75, column 33) + _lhsOppL = + ({-# LINE 75 "AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 348 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 354 "AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 76, column 33) + _lhsOppL = + ({-# LINE 76 "AbstractSyntaxDump.ag" #-} + [] + {-# LINE 369 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + empty + {-# LINE 375 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + pp : PP_Doc + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern ,PP_Doc)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern ,pp_Syn_Pattern :: PP_Doc} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOcopy,_lhsOpp) = sem + in (Syn_Pattern _lhsOcopy _lhsOpp )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIpp :: PP_Doc + _partsIcopy :: Patterns + _partsIpp :: PP_Doc + _partsIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 46, column 33) + _lhsOpp = + ({-# LINE 46 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] + {-# LINE 451 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 457 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 463 "AbstractSyntaxDump.hs" #-} + ) + ( _patIcopy,_patIpp) = + pat_ + ( _partsIcopy,_partsIpp,_partsIppL) = + parts_ + in ( _lhsOcopy,_lhsOpp)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIpp :: PP_Doc + _patsIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 44, column 33) + _lhsOpp = + ({-# LINE 44 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] + {-# LINE 483 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 489 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 495 "AbstractSyntaxDump.hs" #-} + ) + ( _patsIcopy,_patsIpp,_patsIppL) = + pats_ + in ( _lhsOcopy,_lhsOpp)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIpp :: PP_Doc + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + _patIpp + {-# LINE 511 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 517 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 523 "AbstractSyntaxDump.hs" #-} + ) + ( _patIcopy,_patIpp) = + pat_ + in ( _lhsOcopy,_lhsOpp)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIpp :: PP_Doc + _patsIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 45, column 33) + _lhsOpp = + ({-# LINE 45 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] + {-# LINE 541 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 547 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 553 "AbstractSyntaxDump.hs" #-} + ) + ( _patsIcopy,_patsIpp,_patsIppL) = + pats_ + in ( _lhsOcopy,_lhsOpp)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + -- "AbstractSyntaxDump.ag"(line 47, column 25) + _lhsOpp = + ({-# LINE 47 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] + {-# LINE 567 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 573 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 579 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOcopy,_lhsOpp)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( Patterns ,PP_Doc,([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns ,pp_Syn_Patterns :: PP_Doc,ppL_Syn_Patterns :: ([PP_Doc])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOcopy,_lhsOpp,_lhsOppL) = sem + in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIpp :: PP_Doc + _tlIcopy :: Patterns + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 55, column 33) + _lhsOppL = + ({-# LINE 55 "AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 630 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 636 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 642 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 648 "AbstractSyntaxDump.hs" #-} + ) + ( _hdIcopy,_hdIpp) = + hd_ + ( _tlIcopy,_tlIpp,_tlIppL) = + tl_ + in ( _lhsOcopy,_lhsOpp,_lhsOppL)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _lhsOcopy :: Patterns + -- "AbstractSyntaxDump.ag"(line 56, column 33) + _lhsOppL = + ({-# LINE 56 "AbstractSyntaxDump.ag" #-} + [] + {-# LINE 664 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + empty + {-# LINE 670 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 676 "AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 682 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOcopy,_lhsOpp,_lhsOppL)) ) +-- Production -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _children _rules _typeSigs ) = + (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) +-- semantic domain +newtype T_Production = T_Production (( PP_Doc)) +data Inh_Production = Inh_Production {} +data Syn_Production = Syn_Production {pp_Syn_Production :: PP_Doc} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem ) (Inh_Production ) = + (let ( _lhsOpp) = sem + in (Syn_Production _lhsOpp )) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = + (T_Production (let _lhsOpp :: PP_Doc + _childrenIpp :: PP_Doc + _childrenIppL :: ([PP_Doc]) + _rulesIpp :: PP_Doc + _rulesIppL :: ([PP_Doc]) + _typeSigsIpp :: PP_Doc + _typeSigsIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 32, column 25) + _lhsOpp = + ({-# LINE 32 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Production","Production"] [pp con_] [ppF "children" $ ppVList _childrenIppL,ppF "rules" $ ppVList _rulesIppL,ppF "typeSigs" $ ppVList _typeSigsIppL] [] + {-# LINE 729 "AbstractSyntaxDump.hs" #-} + ) + ( _childrenIpp,_childrenIppL) = + children_ + ( _rulesIpp,_rulesIppL) = + rules_ + ( _typeSigsIpp,_typeSigsIppL) = + typeSigs_ + in ( _lhsOpp)) ) +-- Productions ------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) +-- semantic domain +newtype T_Productions = T_Productions (( PP_Doc,([PP_Doc]))) +data Inh_Productions = Inh_Productions {} +data Syn_Productions = Syn_Productions {pp_Syn_Productions :: PP_Doc,ppL_Syn_Productions :: ([PP_Doc])} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem ) (Inh_Productions ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_Productions _lhsOpp _lhsOppL )) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = + (T_Productions (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 71, column 33) + _lhsOppL = + ({-# LINE 71 "AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 778 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 784 "AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 72, column 33) + _lhsOppL = + ({-# LINE 72 "AbstractSyntaxDump.ag" #-} + [] + {-# LINE 799 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + empty + {-# LINE 805 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) +-- Rule -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) +-- semantic domain +newtype T_Rule = T_Rule (( PP_Doc)) +data Inh_Rule = Inh_Rule {} +data Syn_Rule = Syn_Rule {pp_Syn_Rule :: PP_Doc} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem ) (Inh_Rule ) = + (let ( _lhsOpp) = sem + in (Syn_Rule _lhsOpp )) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = + (T_Rule (let _lhsOpp :: PP_Doc + _patternIcopy :: Pattern + _patternIpp :: PP_Doc + _rhsIpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 38, column 33) + _lhsOpp = + ({-# LINE 38 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["Rule","Rule"] [ppShow owrt_, pp origin_] [ppF "pattern" $ _patternIpp, ppF "rhs" $ _rhsIpp] [] + {-# LINE 853 "AbstractSyntaxDump.hs" #-} + ) + ( _patternIcopy,_patternIpp) = + pattern_ + ( _rhsIpp) = + rhs_ + in ( _lhsOpp)) ) +-- Rules ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) +-- semantic domain +newtype T_Rules = T_Rules (( PP_Doc,([PP_Doc]))) +data Inh_Rules = Inh_Rules {} +data Syn_Rules = Syn_Rules {pp_Syn_Rules :: PP_Doc,ppL_Syn_Rules :: ([PP_Doc])} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem ) (Inh_Rules ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_Rules _lhsOpp _lhsOppL )) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) = + (T_Rules (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 63, column 33) + _lhsOppL = + ({-# LINE 63 "AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 900 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 906 "AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 64, column 33) + _lhsOppL = + ({-# LINE 64 "AbstractSyntaxDump.ag" #-} + [] + {-# LINE 921 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + empty + {-# LINE 927 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp ) = + (sem_TypeSig_TypeSig _name _tp ) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( PP_Doc)) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {pp_Syn_TypeSig :: PP_Doc} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) = + (let ( _lhsOpp) = sem + in (Syn_TypeSig _lhsOpp )) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let _lhsOpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 41, column 33) + _lhsOpp = + ({-# LINE 41 "AbstractSyntaxDump.ag" #-} + ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] [] + {-# LINE 964 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp)) ) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( PP_Doc,([PP_Doc]))) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {pp_Syn_TypeSigs :: PP_Doc,ppL_Syn_TypeSigs :: ([PP_Doc])} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_TypeSigs _lhsOpp _lhsOppL )) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) = + (T_TypeSigs (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "AbstractSyntaxDump.ag"(line 59, column 33) + _lhsOppL = + ({-# LINE 59 "AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 1007 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 1013 "AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "AbstractSyntaxDump.ag"(line 60, column 33) + _lhsOppL = + ({-# LINE 60 "AbstractSyntaxDump.ag" #-} + [] + {-# LINE 1028 "AbstractSyntaxDump.hs" #-} + ) + -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "AbstractSyntaxDump.ag" #-} + empty + {-# LINE 1034 "AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) diff --git a/src-derived/Code.hs b/src-derived/Code.hs new file mode 100644 --- /dev/null +++ b/src-derived/Code.hs @@ -0,0 +1,352 @@ + + +-- UUAGC 0.9.38.1 (Code.ag) +module Code where +{-# LINE 2 "Code.ag" #-} + +import Pretty +import Patterns +import Data.List(partition) +import Data.Set(Set) +import qualified Data.Set as Set +import Data.Map(Map) +import qualified Data.Map as Map +{-# LINE 15 "../src-derived/Code.hs" #-} +{-# LINE 145 "Code.ag" #-} + +-- Unboxed tuples +-- unbox Whether unboxed tuples are wanted or not +-- inh The inherited attributes. +-- If there are none, no unboxing can take place, +-- because in that case the semantic function (a top-level identifier) would have an unboxed type. +-- Of course we can't have an unboxed 1-tuple +mkTupleExpr :: Bool -> Bool -> Exprs -> Expr +mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs + | otherwise = UnboxedTupleExpr exprs +mkTupleType :: Bool -> Bool -> Types -> Type +mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps + | otherwise = UnboxedTupleType tps +mkTupleLhs :: Bool -> Bool -> [String] -> Lhs +mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps + | otherwise = UnboxedTupleLhs comps +{-# LINE 33 "../src-derived/Code.hs" #-} +-- CaseAlt ----------------------------------------------------- +{- + alternatives: + alternative CaseAlt: + child left : Lhs + child expr : Expr +-} +data CaseAlt = CaseAlt (Lhs ) (Expr ) +-- CaseAlts ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CaseAlt + child tl : CaseAlts + alternative Nil: +-} +type CaseAlts = [CaseAlt ] +-- Chunk ------------------------------------------------------- +{- + alternatives: + alternative Chunk: + child name : {String} + child comment : Decl + child info : Decls + child dataDef : Decls + child cataFun : Decls + child semDom : Decls + child semWrapper : Decls + child semFunctions : Decls + child semNames : {[String]} +-} +data Chunk = Chunk (String) (Decl ) (Decls ) (Decls ) (Decls ) (Decls ) (Decls ) (Decls ) (([String])) +-- Chunks ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Chunk + child tl : Chunks + alternative Nil: +-} +type Chunks = [Chunk ] +-- DataAlt ----------------------------------------------------- +{- + alternatives: + alternative DataAlt: + child name : {String} + child args : Types + alternative Record: + child name : {String} + child args : NamedTypes +-} +data DataAlt = DataAlt (String) (Types ) + | Record (String) (NamedTypes ) +-- DataAlts ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : DataAlt + child tl : DataAlts + alternative Nil: +-} +type DataAlts = [DataAlt ] +-- Decl -------------------------------------------------------- +{- + alternatives: + alternative Bind: + child left : Lhs + child rhs : Expr + alternative BindLet: + child left : Lhs + child rhs : Expr + alternative Comment: + child txt : {String} + alternative Data: + child name : {String} + child params : {[String]} + child alts : DataAlts + child strict : {Bool} + child derivings : {[String]} + alternative Decl: + child left : Lhs + child rhs : Expr + child binds : {Set String} + child uses : {Set String} + alternative EvalDecl: + child nt : {String} + child left : Lhs + child rhs : Expr + alternative NewType: + child name : {String} + child params : {[String]} + child con : {String} + child tp : Type + alternative PragmaDecl: + child txt : {String} + alternative Resume: + child monadic : {Bool} + child nt : {String} + child left : Lhs + child rhs : Expr + alternative TSig: + child name : {String} + child tp : Type + alternative Type: + child name : {String} + child params : {[String]} + child tp : Type +-} +data Decl = Bind (Lhs ) (Expr ) + | BindLet (Lhs ) (Expr ) + | Comment (String) + | Data (String) (([String])) (DataAlts ) (Bool) (([String])) + | Decl (Lhs ) (Expr ) ((Set String)) ((Set String)) + | EvalDecl (String) (Lhs ) (Expr ) + | NewType (String) (([String])) (String) (Type ) + | PragmaDecl (String) + | Resume (Bool) (String) (Lhs ) (Expr ) + | TSig (String) (Type ) + | Type (String) (([String])) (Type ) +-- Decls ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Decl + child tl : Decls + alternative Nil: +-} +type Decls = [Decl ] +-- Expr -------------------------------------------------------- +{- + alternatives: + alternative App: + child name : {String} + child args : Exprs + alternative Case: + child expr : Expr + child alts : CaseAlts + alternative Do: + child stmts : Decls + child body : Expr + alternative InvokeExpr: + child nt : {String} + child expr : Expr + child args : Exprs + alternative Lambda: + child args : Exprs + child body : Expr + alternative Let: + child decls : Decls + child body : Expr + alternative LineExpr: + child expr : Expr + alternative PragmaExpr: + child onLeftSide : {Bool} + child onNewLine : {Bool} + child txt : {String} + child expr : Expr + alternative ResultExpr: + child nt : {String} + child expr : Expr + alternative ResumeExpr: + child nt : {String} + child expr : Expr + child left : Lhs + child rhs : Expr + alternative SemFun: + child nt : {String} + child args : Exprs + child body : Expr + alternative SimpleExpr: + child txt : {String} + alternative TextExpr: + child lns : {[String]} + alternative Trace: + child txt : {String} + child expr : Expr + alternative TupleExpr: + child exprs : Exprs + alternative TypedExpr: + child expr : Expr + child tp : Type + alternative UnboxedTupleExpr: + child exprs : Exprs +-} +data Expr = App (String) (Exprs ) + | Case (Expr ) (CaseAlts ) + | Do (Decls ) (Expr ) + | InvokeExpr (String) (Expr ) (Exprs ) + | Lambda (Exprs ) (Expr ) + | Let (Decls ) (Expr ) + | LineExpr (Expr ) + | PragmaExpr (Bool) (Bool) (String) (Expr ) + | ResultExpr (String) (Expr ) + | ResumeExpr (String) (Expr ) (Lhs ) (Expr ) + | SemFun (String) (Exprs ) (Expr ) + | SimpleExpr (String) + | TextExpr (([String])) + | Trace (String) (Expr ) + | TupleExpr (Exprs ) + | TypedExpr (Expr ) (Type ) + | UnboxedTupleExpr (Exprs ) +-- Exprs ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Expr + child tl : Exprs + alternative Nil: +-} +type Exprs = [Expr ] +-- Lhs --------------------------------------------------------- +{- + alternatives: + alternative Fun: + child name : {String} + child args : Exprs + alternative Pattern3: + child pat3 : {Pattern} + alternative Pattern3SM: + child pat3 : {Pattern} + alternative TupleLhs: + child comps : {[String]} + alternative UnboxedTupleLhs: + child comps : {[String]} + alternative Unwrap: + child name : {String} + child sub : Lhs +-} +data Lhs = Fun (String) (Exprs ) + | Pattern3 (Pattern) + | Pattern3SM (Pattern) + | TupleLhs (([String])) + | UnboxedTupleLhs (([String])) + | Unwrap (String) (Lhs ) +-- NamedType --------------------------------------------------- +{- + alternatives: + alternative Named: + child strict : {Bool} + child name : {String} + child tp : Type +-} +data NamedType = Named (Bool) (String) (Type ) +-- NamedTypes -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : NamedType + child tl : NamedTypes + alternative Nil: +-} +type NamedTypes = [NamedType ] +-- Program ----------------------------------------------------- +{- + alternatives: + alternative Program: + child chunks : Chunks + child ordered : {Bool} +-} +data Program = Program (Chunks ) (Bool) +-- Type -------------------------------------------------------- +{- + alternatives: + alternative Arr: + child left : Type + child right : Type + alternative CtxApp: + child left : {[(String, [String])]} + child right : Type + alternative List: + child tp : Type + alternative NontermType: + child name : {String} + child params : {[String]} + alternative QuantApp: + child left : {String} + child right : Type + alternative SimpleType: + child txt : {String} + alternative TEither: + child left : Type + child right : Type + alternative TIntMap: + child value : Type + alternative TMap: + child key : Type + child value : Type + alternative TMaybe: + child tp : Type + alternative TupleType: + child tps : Types + alternative TypeApp: + child func : Type + child args : Types + alternative UnboxedTupleType: + child tps : Types +-} +data Type = Arr (Type ) (Type ) + | CtxApp (([(String, [String])])) (Type ) + | List (Type ) + | NontermType (String) (([String])) + | QuantApp (String) (Type ) + | SimpleType (String) + | TEither (Type ) (Type ) + | TIntMap (Type ) + | TMap (Type ) (Type ) + | TMaybe (Type ) + | TupleType (Types ) + | TypeApp (Type ) (Types ) + | UnboxedTupleType (Types ) + deriving ( Show) +-- Types ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Type + child tl : Types + alternative Nil: +-} +type Types = [Type ] diff --git a/src-derived/CodeSyntax.hs b/src-derived/CodeSyntax.hs new file mode 100644 --- /dev/null +++ b/src-derived/CodeSyntax.hs @@ -0,0 +1,151 @@ + + +-- UUAGC 0.9.38.1 (CodeSyntax.ag) +module CodeSyntax where +{-# LINE 2 "CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 12 "../src-derived/CodeSyntax.hs" #-} +-- CGrammar ---------------------------------------------------- +{- + alternatives: + alternative CGrammar: + child typeSyns : {TypeSyns} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : CNonterminals + child pragmas : {PragmaMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + child multivisit : {Bool} +-} +data CGrammar = CGrammar (TypeSyns) (Derivings) ((Set NontermIdent)) (CNonterminals ) (PragmaMap) (ParamMap) (ContextMap) (QuantMap) ((Map NontermIdent (Map ConstructorIdent (Set Identifier)))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))) (Bool) +-- CInterface -------------------------------------------------- +{- + alternatives: + alternative CInterface: + child seg : CSegments +-} +data CInterface = CInterface (CSegments ) +-- CNonterminal ------------------------------------------------ +{- + alternatives: + alternative CNonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : CProductions + child inter : CInterface +-} +data CNonterminal = CNonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (CProductions ) (CInterface ) +-- CNonterminals ----------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CNonterminal + child tl : CNonterminals + alternative Nil: +-} +type CNonterminals = [CNonterminal ] +-- CProduction ------------------------------------------------- +{- + alternatives: + alternative CProduction: + child con : {ConstructorIdent} + child visits : CVisits + child children : {[(Identifier,Type,Maybe (Maybe Type))]} + child terminals : {[Identifier]} +-} +data CProduction = CProduction (ConstructorIdent) (CVisits ) (([(Identifier,Type,Maybe (Maybe Type))])) (([Identifier])) +-- CProductions ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : CProduction + child tl : CProductions + alternative Nil: +-} +type CProductions = [CProduction ] +-- CRule ------------------------------------------------------- +{- + alternatives: + alternative CChildVisit: + child name : {Identifier} + child nt : {NontermIdent} + child nr : {Int} + child inh : {Attributes} + child syn : {Attributes} + child isLast : {Bool} + alternative CRule: + child name : {Identifier} + child isIn : {Bool} + child hasCode : {Bool} + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child childnt : {Maybe NontermIdent} + child tp : {Maybe Type} + child pattern : {Pattern} + child rhs : {[String]} + child defines : {Map Int (Identifier,Identifier,Maybe Type)} + child owrt : {Bool} + child origin : {String} + child uses : {Set (Identifier, Identifier)} + child explicit : {Bool} + child mbNamed : {Maybe Identifier} +-} +data CRule = CChildVisit (Identifier) (NontermIdent) (Int) (Attributes) (Attributes) (Bool) + | CRule (Identifier) (Bool) (Bool) (NontermIdent) (ConstructorIdent) (Identifier) ((Maybe NontermIdent)) ((Maybe Type)) (Pattern) (([String])) ((Map Int (Identifier,Identifier,Maybe Type))) (Bool) (String) ((Set (Identifier, Identifier))) (Bool) ((Maybe Identifier)) +-- CSegment ---------------------------------------------------- +{- + alternatives: + alternative CSegment: + child inh : {Attributes} + child syn : {Attributes} +-} +data CSegment = CSegment (Attributes) (Attributes) +-- CSegments --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CSegment + child tl : CSegments + alternative Nil: +-} +type CSegments = [CSegment ] +-- CVisit ------------------------------------------------------ +{- + alternatives: + alternative CVisit: + child inh : {Attributes} + child syn : {Attributes} + child vss : Sequence + child intra : Sequence + child ordered : {Bool} +-} +data CVisit = CVisit (Attributes) (Attributes) (Sequence ) (Sequence ) (Bool) +-- CVisits ----------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CVisit + child tl : CVisits + alternative Nil: +-} +type CVisits = [CVisit ] +-- Sequence ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CRule + child tl : Sequence + alternative Nil: +-} +type Sequence = [CRule ] diff --git a/src-derived/CodeSyntaxDump.hs b/src-derived/CodeSyntaxDump.hs new file mode 100644 --- /dev/null +++ b/src-derived/CodeSyntaxDump.hs @@ -0,0 +1,1077 @@ + + +-- UUAGC 0.9.38.1 (CodeSyntaxDump.ag) +module CodeSyntaxDump where +{-# LINE 5 "CodeSyntaxDump.ag" #-} + +import Data.List +import qualified Data.Map as Map + +import Pretty +import PPUtil + +import CodeSyntax +{-# LINE 15 "../src-derived/CodeSyntaxDump.hs" #-} + +{-# LINE 2 "./CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 23 "../src-derived/CodeSyntaxDump.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 30 "../src-derived/CodeSyntaxDump.hs" #-} +{-# LINE 15 "CodeSyntaxDump.ag" #-} + +ppChild :: (Identifier,Type,Maybe (Maybe Type)) -> PP_Doc +ppChild (nm,tp,b) + = pp nm >#< "::" >#< pp (show tp) + +ppVertexMap :: Map Int (Identifier,Identifier,Maybe Type) -> PP_Doc +ppVertexMap m + = ppVList [ ppF (show k) $ ppAttr v | (k,v) <- Map.toList m ] + +ppAttr :: (Identifier,Identifier,Maybe Type) -> PP_Doc +ppAttr (fld,nm,mTp) + = pp fld >|< "." >|< pp nm >#< + case mTp of + Just tp -> pp "::" >#< show tp + Nothing -> empty + +ppBool :: Bool -> PP_Doc +ppBool True = pp "T" +ppBool False = pp "F" + +ppMaybeShow :: Show a => Maybe a -> PP_Doc +ppMaybeShow (Just x) = pp (show x) +ppMaybeShow Nothing = pp "_" + +ppStrings :: [String] -> PP_Doc +ppStrings = vlist +{-# LINE 58 "../src-derived/CodeSyntaxDump.hs" #-} +-- CGrammar ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CGrammar: + child typeSyns : {TypeSyns} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : CNonterminals + child pragmas : {PragmaMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + child multivisit : {Bool} +-} +-- cata +sem_CGrammar :: CGrammar -> + T_CGrammar +sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _nonts _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit ) = + (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CNonterminals _nonts ) _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit ) +-- semantic domain +newtype T_CGrammar = T_CGrammar (( PP_Doc)) +data Inh_CGrammar = Inh_CGrammar {} +data Syn_CGrammar = Syn_CGrammar {pp_Syn_CGrammar :: PP_Doc} +wrap_CGrammar :: T_CGrammar -> + Inh_CGrammar -> + Syn_CGrammar +wrap_CGrammar (T_CGrammar sem ) (Inh_CGrammar ) = + (let ( _lhsOpp) = sem + in (Syn_CGrammar _lhsOpp )) +sem_CGrammar_CGrammar :: TypeSyns -> + Derivings -> + (Set NontermIdent) -> + T_CNonterminals -> + PragmaMap -> + ParamMap -> + ContextMap -> + QuantMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + T_CGrammar +sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ = + (T_CGrammar (let _lhsOpp :: PP_Doc + _nontsIpp :: PP_Doc + _nontsIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 47, column 21) + _lhsOpp = + ({-# LINE 47 "CodeSyntaxDump.ag" #-} + ppNestInfo ["CGrammar","CGrammar"] [] + [ ppF "typeSyns" $ ppAssocL typeSyns_ + , ppF "derivings" $ ppMap $ derivings_ + , ppF "nonts" $ ppVList _nontsIppL + ] [] + {-# LINE 117 "CodeSyntaxDump.hs" #-} + ) + ( _nontsIpp,_nontsIppL) = + nonts_ + in ( _lhsOpp)) ) +-- CInterface -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CInterface: + child seg : CSegments +-} +-- cata +sem_CInterface :: CInterface -> + T_CInterface +sem_CInterface (CInterface _seg ) = + (sem_CInterface_CInterface (sem_CSegments _seg ) ) +-- semantic domain +newtype T_CInterface = T_CInterface (( PP_Doc)) +data Inh_CInterface = Inh_CInterface {} +data Syn_CInterface = Syn_CInterface {pp_Syn_CInterface :: PP_Doc} +wrap_CInterface :: T_CInterface -> + Inh_CInterface -> + Syn_CInterface +wrap_CInterface (T_CInterface sem ) (Inh_CInterface ) = + (let ( _lhsOpp) = sem + in (Syn_CInterface _lhsOpp )) +sem_CInterface_CInterface :: T_CSegments -> + T_CInterface +sem_CInterface_CInterface (T_CSegments seg_ ) = + (T_CInterface (let _lhsOpp :: PP_Doc + _segIpp :: PP_Doc + _segIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 57, column 21) + _lhsOpp = + ({-# LINE 57 "CodeSyntaxDump.ag" #-} + ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] [] + {-# LINE 156 "CodeSyntaxDump.hs" #-} + ) + ( _segIpp,_segIppL) = + seg_ + in ( _lhsOpp)) ) +-- CNonterminal ------------------------------------------------ +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CNonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : CProductions + child inter : CInterface +-} +-- cata +sem_CNonterminal :: CNonterminal -> + T_CNonterminal +sem_CNonterminal (CNonterminal _nt _params _inh _syn _prods _inter ) = + (sem_CNonterminal_CNonterminal _nt _params _inh _syn (sem_CProductions _prods ) (sem_CInterface _inter ) ) +-- semantic domain +newtype T_CNonterminal = T_CNonterminal (( PP_Doc)) +data Inh_CNonterminal = Inh_CNonterminal {} +data Syn_CNonterminal = Syn_CNonterminal {pp_Syn_CNonterminal :: PP_Doc} +wrap_CNonterminal :: T_CNonterminal -> + Inh_CNonterminal -> + Syn_CNonterminal +wrap_CNonterminal (T_CNonterminal sem ) (Inh_CNonterminal ) = + (let ( _lhsOpp) = sem + in (Syn_CNonterminal _lhsOpp )) +sem_CNonterminal_CNonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_CProductions -> + T_CInterface -> + T_CNonterminal +sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_ ) (T_CInterface inter_ ) = + (T_CNonterminal (let _lhsOpp :: PP_Doc + _prodsIpp :: PP_Doc + _prodsIppL :: ([PP_Doc]) + _interIpp :: PP_Doc + -- "CodeSyntaxDump.ag"(line 54, column 33) + _lhsOpp = + ({-# LINE 54 "CodeSyntaxDump.ag" #-} + ppNestInfo ["CNonterminal","CNonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL, ppF "inter" _interIpp] [] + {-# LINE 206 "CodeSyntaxDump.hs" #-} + ) + ( _prodsIpp,_prodsIppL) = + prods_ + ( _interIpp) = + inter_ + in ( _lhsOpp)) ) +-- CNonterminals ----------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CNonterminal + child tl : CNonterminals + alternative Nil: +-} +-- cata +sem_CNonterminals :: CNonterminals -> + T_CNonterminals +sem_CNonterminals list = + (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list) ) +-- semantic domain +newtype T_CNonterminals = T_CNonterminals (( PP_Doc,([PP_Doc]))) +data Inh_CNonterminals = Inh_CNonterminals {} +data Syn_CNonterminals = Syn_CNonterminals {pp_Syn_CNonterminals :: PP_Doc,ppL_Syn_CNonterminals :: ([PP_Doc])} +wrap_CNonterminals :: T_CNonterminals -> + Inh_CNonterminals -> + Syn_CNonterminals +wrap_CNonterminals (T_CNonterminals sem ) (Inh_CNonterminals ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_CNonterminals _lhsOpp _lhsOppL )) +sem_CNonterminals_Cons :: T_CNonterminal -> + T_CNonterminals -> + T_CNonterminals +sem_CNonterminals_Cons (T_CNonterminal hd_ ) (T_CNonterminals tl_ ) = + (T_CNonterminals (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 102, column 33) + _lhsOppL = + ({-# LINE 102 "CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 253 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 259 "CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_CNonterminals_Nil :: T_CNonterminals +sem_CNonterminals_Nil = + (T_CNonterminals (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "CodeSyntaxDump.ag"(line 103, column 33) + _lhsOppL = + ({-# LINE 103 "CodeSyntaxDump.ag" #-} + [] + {-# LINE 274 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + empty + {-# LINE 280 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) +-- CProduction ------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CProduction: + child con : {ConstructorIdent} + child visits : CVisits + child children : {[(Identifier,Type,Maybe (Maybe Type))]} + child terminals : {[Identifier]} +-} +-- cata +sem_CProduction :: CProduction -> + T_CProduction +sem_CProduction (CProduction _con _visits _children _terminals ) = + (sem_CProduction_CProduction _con (sem_CVisits _visits ) _children _terminals ) +-- semantic domain +newtype T_CProduction = T_CProduction (( PP_Doc)) +data Inh_CProduction = Inh_CProduction {} +data Syn_CProduction = Syn_CProduction {pp_Syn_CProduction :: PP_Doc} +wrap_CProduction :: T_CProduction -> + Inh_CProduction -> + Syn_CProduction +wrap_CProduction (T_CProduction sem ) (Inh_CProduction ) = + (let ( _lhsOpp) = sem + in (Syn_CProduction _lhsOpp )) +sem_CProduction_CProduction :: ConstructorIdent -> + T_CVisits -> + ([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + T_CProduction +sem_CProduction_CProduction con_ (T_CVisits visits_ ) children_ terminals_ = + (T_CProduction (let _lhsOpp :: PP_Doc + _visitsIpp :: PP_Doc + _visitsIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 63, column 17) + _lhsOpp = + ({-# LINE 63 "CodeSyntaxDump.ag" #-} + ppNestInfo ["CProduction","CProduction"] [pp con_] [ppF "visits" $ ppVList _visitsIppL, ppF "children" $ ppVList (map ppChild children_),ppF "terminals" $ ppVList (map ppShow terminals_)] [] + {-# LINE 323 "CodeSyntaxDump.hs" #-} + ) + ( _visitsIpp,_visitsIppL) = + visits_ + in ( _lhsOpp)) ) +-- CProductions ------------------------------------------------ +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CProduction + child tl : CProductions + alternative Nil: +-} +-- cata +sem_CProductions :: CProductions -> + T_CProductions +sem_CProductions list = + (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) ) +-- semantic domain +newtype T_CProductions = T_CProductions (( PP_Doc,([PP_Doc]))) +data Inh_CProductions = Inh_CProductions {} +data Syn_CProductions = Syn_CProductions {pp_Syn_CProductions :: PP_Doc,ppL_Syn_CProductions :: ([PP_Doc])} +wrap_CProductions :: T_CProductions -> + Inh_CProductions -> + Syn_CProductions +wrap_CProductions (T_CProductions sem ) (Inh_CProductions ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_CProductions _lhsOpp _lhsOppL )) +sem_CProductions_Cons :: T_CProduction -> + T_CProductions -> + T_CProductions +sem_CProductions_Cons (T_CProduction hd_ ) (T_CProductions tl_ ) = + (T_CProductions (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 94, column 33) + _lhsOppL = + ({-# LINE 94 "CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 368 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 374 "CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_CProductions_Nil :: T_CProductions +sem_CProductions_Nil = + (T_CProductions (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "CodeSyntaxDump.ag"(line 95, column 33) + _lhsOppL = + ({-# LINE 95 "CodeSyntaxDump.ag" #-} + [] + {-# LINE 389 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + empty + {-# LINE 395 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) +-- CRule ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CChildVisit: + child name : {Identifier} + child nt : {NontermIdent} + child nr : {Int} + child inh : {Attributes} + child syn : {Attributes} + child isLast : {Bool} + alternative CRule: + child name : {Identifier} + child isIn : {Bool} + child hasCode : {Bool} + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child childnt : {Maybe NontermIdent} + child tp : {Maybe Type} + child pattern : Pattern + child rhs : {[String]} + child defines : {Map Int (Identifier,Identifier,Maybe Type)} + child owrt : {Bool} + child origin : {String} + child uses : {Set (Identifier, Identifier)} + child explicit : {Bool} + child mbNamed : {Maybe Identifier} +-} +-- cata +sem_CRule :: CRule -> + T_CRule +sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) = + (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast ) +sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses _explicit _mbNamed ) = + (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern ) _rhs _defines _owrt _origin _uses _explicit _mbNamed ) +-- semantic domain +newtype T_CRule = T_CRule (( PP_Doc)) +data Inh_CRule = Inh_CRule {} +data Syn_CRule = Syn_CRule {pp_Syn_CRule :: PP_Doc} +wrap_CRule :: T_CRule -> + Inh_CRule -> + Syn_CRule +wrap_CRule (T_CRule sem ) (Inh_CRule ) = + (let ( _lhsOpp) = sem + in (Syn_CRule _lhsOpp )) +sem_CRule_CChildVisit :: Identifier -> + NontermIdent -> + Int -> + Attributes -> + Attributes -> + Bool -> + T_CRule +sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = + (T_CRule (let _lhsOpp :: PP_Doc + -- "CodeSyntaxDump.ag"(line 70, column 21) + _lhsOpp = + ({-# LINE 70 "CodeSyntaxDump.ag" #-} + ppNestInfo ["CRule","CChildVisit"] [pp name_] [ppF "nt" $ pp nt_, ppF "nr" $ ppShow nr_, ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "last" $ ppBool isLast_] [] + {-# LINE 459 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp)) ) +sem_CRule_CRule :: Identifier -> + Bool -> + Bool -> + NontermIdent -> + ConstructorIdent -> + Identifier -> + (Maybe NontermIdent) -> + (Maybe Type) -> + T_Pattern -> + ([String]) -> + (Map Int (Identifier,Identifier,Maybe Type)) -> + Bool -> + String -> + (Set (Identifier, Identifier)) -> + Bool -> + (Maybe Identifier) -> + T_CRule +sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ = + (T_CRule (let _lhsOpp :: PP_Doc + _patternIcopy :: Pattern + _patternIpp :: PP_Doc + -- "CodeSyntaxDump.ag"(line 69, column 33) + _lhsOpp = + ({-# LINE 69 "CodeSyntaxDump.ag" #-} + ppNestInfo ["CRule","CRule"] [pp name_] [ppF "isIn" $ ppBool isIn_, ppF "hasCode" $ ppBool hasCode_, ppF "nt" $ pp nt_, ppF "con" $ pp con_, ppF "field" $ pp field_, ppF "childnt" $ ppMaybeShow childnt_, ppF "tp" $ ppMaybeShow tp_, ppF "pattern" $ if isIn_ then pp "" else _patternIpp, ppF "rhs" $ ppStrings rhs_, ppF "defines" $ ppVertexMap defines_, ppF "owrt" $ ppBool owrt_, ppF "origin" $ pp origin_] [] + {-# LINE 487 "CodeSyntaxDump.hs" #-} + ) + ( _patternIcopy,_patternIpp) = + pattern_ + in ( _lhsOpp)) ) +-- CSegment ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CSegment: + child inh : {Attributes} + child syn : {Attributes} +-} +-- cata +sem_CSegment :: CSegment -> + T_CSegment +sem_CSegment (CSegment _inh _syn ) = + (sem_CSegment_CSegment _inh _syn ) +-- semantic domain +newtype T_CSegment = T_CSegment (( PP_Doc)) +data Inh_CSegment = Inh_CSegment {} +data Syn_CSegment = Syn_CSegment {pp_Syn_CSegment :: PP_Doc} +wrap_CSegment :: T_CSegment -> + Inh_CSegment -> + Syn_CSegment +wrap_CSegment (T_CSegment sem ) (Inh_CSegment ) = + (let ( _lhsOpp) = sem + in (Syn_CSegment _lhsOpp )) +sem_CSegment_CSegment :: Attributes -> + Attributes -> + T_CSegment +sem_CSegment_CSegment inh_ syn_ = + (T_CSegment (let _lhsOpp :: PP_Doc + -- "CodeSyntaxDump.ag"(line 60, column 21) + _lhsOpp = + ({-# LINE 60 "CodeSyntaxDump.ag" #-} + ppNestInfo ["CSegment","CSegment"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] [] + {-# LINE 526 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp)) ) +-- CSegments --------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CSegment + child tl : CSegments + alternative Nil: +-} +-- cata +sem_CSegments :: CSegments -> + T_CSegments +sem_CSegments list = + (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) ) +-- semantic domain +newtype T_CSegments = T_CSegments (( PP_Doc,([PP_Doc]))) +data Inh_CSegments = Inh_CSegments {} +data Syn_CSegments = Syn_CSegments {pp_Syn_CSegments :: PP_Doc,ppL_Syn_CSegments :: ([PP_Doc])} +wrap_CSegments :: T_CSegments -> + Inh_CSegments -> + Syn_CSegments +wrap_CSegments (T_CSegments sem ) (Inh_CSegments ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_CSegments _lhsOpp _lhsOppL )) +sem_CSegments_Cons :: T_CSegment -> + T_CSegments -> + T_CSegments +sem_CSegments_Cons (T_CSegment hd_ ) (T_CSegments tl_ ) = + (T_CSegments (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 98, column 33) + _lhsOppL = + ({-# LINE 98 "CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 569 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 575 "CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_CSegments_Nil :: T_CSegments +sem_CSegments_Nil = + (T_CSegments (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "CodeSyntaxDump.ag"(line 99, column 33) + _lhsOppL = + ({-# LINE 99 "CodeSyntaxDump.ag" #-} + [] + {-# LINE 590 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + empty + {-# LINE 596 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) +-- CVisit ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CVisit: + child inh : {Attributes} + child syn : {Attributes} + child vss : Sequence + child intra : Sequence + child ordered : {Bool} +-} +-- cata +sem_CVisit :: CVisit -> + T_CVisit +sem_CVisit (CVisit _inh _syn _vss _intra _ordered ) = + (sem_CVisit_CVisit _inh _syn (sem_Sequence _vss ) (sem_Sequence _intra ) _ordered ) +-- semantic domain +newtype T_CVisit = T_CVisit (( PP_Doc)) +data Inh_CVisit = Inh_CVisit {} +data Syn_CVisit = Syn_CVisit {pp_Syn_CVisit :: PP_Doc} +wrap_CVisit :: T_CVisit -> + Inh_CVisit -> + Syn_CVisit +wrap_CVisit (T_CVisit sem ) (Inh_CVisit ) = + (let ( _lhsOpp) = sem + in (Syn_CVisit _lhsOpp )) +sem_CVisit_CVisit :: Attributes -> + Attributes -> + T_Sequence -> + T_Sequence -> + Bool -> + T_CVisit +sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_ ) (T_Sequence intra_ ) ordered_ = + (T_CVisit (let _lhsOpp :: PP_Doc + _vssIppL :: ([PP_Doc]) + _intraIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 66, column 21) + _lhsOpp = + ({-# LINE 66 "CodeSyntaxDump.ag" #-} + ppNestInfo ["CVisit","CVisit"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "sequence" $ ppVList _vssIppL, ppF "intra" $ ppVList _intraIppL, ppF "ordered" $ ppBool ordered_] [] + {-# LINE 641 "CodeSyntaxDump.hs" #-} + ) + ( _vssIppL) = + vss_ + ( _intraIppL) = + intra_ + in ( _lhsOpp)) ) +-- CVisits ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CVisit + child tl : CVisits + alternative Nil: +-} +-- cata +sem_CVisits :: CVisits -> + T_CVisits +sem_CVisits list = + (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) ) +-- semantic domain +newtype T_CVisits = T_CVisits (( PP_Doc,([PP_Doc]))) +data Inh_CVisits = Inh_CVisits {} +data Syn_CVisits = Syn_CVisits {pp_Syn_CVisits :: PP_Doc,ppL_Syn_CVisits :: ([PP_Doc])} +wrap_CVisits :: T_CVisits -> + Inh_CVisits -> + Syn_CVisits +wrap_CVisits (T_CVisits sem ) (Inh_CVisits ) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_CVisits _lhsOpp _lhsOppL )) +sem_CVisits_Cons :: T_CVisit -> + T_CVisits -> + T_CVisits +sem_CVisits_Cons (T_CVisit hd_ ) (T_CVisits tl_ ) = + (T_CVisits (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 90, column 33) + _lhsOppL = + ({-# LINE 90 "CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 688 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 694 "CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL)) ) +sem_CVisits_Nil :: T_CVisits +sem_CVisits_Nil = + (T_CVisits (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "CodeSyntaxDump.ag"(line 91, column 33) + _lhsOppL = + ({-# LINE 91 "CodeSyntaxDump.ag" #-} + [] + {-# LINE 709 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + empty + {-# LINE 715 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL)) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + pp : PP_Doc + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern ,PP_Doc)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern ,pp_Syn_Pattern :: PP_Doc} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOcopy,_lhsOpp) = sem + in (Syn_Pattern _lhsOcopy _lhsOpp )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIpp :: PP_Doc + _partsIcopy :: Patterns + _partsIpp :: PP_Doc + _partsIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 75, column 33) + _lhsOpp = + ({-# LINE 75 "CodeSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] + {-# LINE 791 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 797 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 803 "CodeSyntaxDump.hs" #-} + ) + ( _patIcopy,_patIpp) = + pat_ + ( _partsIcopy,_partsIpp,_partsIppL) = + parts_ + in ( _lhsOcopy,_lhsOpp)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIpp :: PP_Doc + _patsIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 73, column 33) + _lhsOpp = + ({-# LINE 73 "CodeSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] + {-# LINE 823 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 829 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 835 "CodeSyntaxDump.hs" #-} + ) + ( _patsIcopy,_patsIpp,_patsIppL) = + pats_ + in ( _lhsOcopy,_lhsOpp)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIpp :: PP_Doc + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + _patIpp + {-# LINE 851 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 857 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 863 "CodeSyntaxDump.hs" #-} + ) + ( _patIcopy,_patIpp) = + pat_ + in ( _lhsOcopy,_lhsOpp)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIpp :: PP_Doc + _patsIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 74, column 33) + _lhsOpp = + ({-# LINE 74 "CodeSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] + {-# LINE 881 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 887 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 893 "CodeSyntaxDump.hs" #-} + ) + ( _patsIcopy,_patsIpp,_patsIppL) = + pats_ + in ( _lhsOcopy,_lhsOpp)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + -- "CodeSyntaxDump.ag"(line 76, column 25) + _lhsOpp = + ({-# LINE 76 "CodeSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] + {-# LINE 907 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 913 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 919 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOcopy,_lhsOpp)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( Patterns ,PP_Doc,([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns ,pp_Syn_Patterns :: PP_Doc,ppL_Syn_Patterns :: ([PP_Doc])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOcopy,_lhsOpp,_lhsOppL) = sem + in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIpp :: PP_Doc + _tlIcopy :: Patterns + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 82, column 33) + _lhsOppL = + ({-# LINE 82 "CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 970 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 976 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 982 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 988 "CodeSyntaxDump.hs" #-} + ) + ( _hdIcopy,_hdIpp) = + hd_ + ( _tlIcopy,_tlIpp,_tlIppL) = + tl_ + in ( _lhsOcopy,_lhsOpp,_lhsOppL)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _lhsOcopy :: Patterns + -- "CodeSyntaxDump.ag"(line 83, column 33) + _lhsOppL = + ({-# LINE 83 "CodeSyntaxDump.ag" #-} + [] + {-# LINE 1004 "CodeSyntaxDump.hs" #-} + ) + -- use rule "CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "CodeSyntaxDump.ag" #-} + empty + {-# LINE 1010 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 1016 "CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1022 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOcopy,_lhsOpp,_lhsOppL)) ) +-- Sequence ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CRule + child tl : Sequence + alternative Nil: +-} +-- cata +sem_Sequence :: Sequence -> + T_Sequence +sem_Sequence list = + (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) ) +-- semantic domain +newtype T_Sequence = T_Sequence (( ([PP_Doc]))) +data Inh_Sequence = Inh_Sequence {} +data Syn_Sequence = Syn_Sequence {ppL_Syn_Sequence :: ([PP_Doc])} +wrap_Sequence :: T_Sequence -> + Inh_Sequence -> + Syn_Sequence +wrap_Sequence (T_Sequence sem ) (Inh_Sequence ) = + (let ( _lhsOppL) = sem + in (Syn_Sequence _lhsOppL )) +sem_Sequence_Cons :: T_CRule -> + T_Sequence -> + T_Sequence +sem_Sequence_Cons (T_CRule hd_ ) (T_Sequence tl_ ) = + (T_Sequence (let _lhsOppL :: ([PP_Doc]) + _hdIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 86, column 33) + _lhsOppL = + ({-# LINE 86 "CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 1062 "CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIppL) = + tl_ + in ( _lhsOppL)) ) +sem_Sequence_Nil :: T_Sequence +sem_Sequence_Nil = + (T_Sequence (let _lhsOppL :: ([PP_Doc]) + -- "CodeSyntaxDump.ag"(line 87, column 33) + _lhsOppL = + ({-# LINE 87 "CodeSyntaxDump.ag" #-} + [] + {-# LINE 1076 "CodeSyntaxDump.hs" #-} + ) + in ( _lhsOppL)) ) diff --git a/src-derived/ConcreteSyntax.hs b/src-derived/ConcreteSyntax.hs new file mode 100644 --- /dev/null +++ b/src-derived/ConcreteSyntax.hs @@ -0,0 +1,235 @@ + + +-- UUAGC 0.9.38.1 (ConcreteSyntax.ag) +module ConcreteSyntax where +{-# LINE 2 "ConcreteSyntax.ag" #-} + +import UU.Scanner.Position (Pos) +import Patterns (Pattern) +import Expression (Expression) +import CommonTypes +{-# LINE 12 "../src-derived/ConcreteSyntax.hs" #-} +-- AG ---------------------------------------------------------- +{- + alternatives: + alternative AG: + child elems : Elems +-} +data AG = AG (Elems ) +-- Alt --------------------------------------------------------- +{- + alternatives: + alternative Alt: + child pos : {Pos} + child names : ConstructorSet + child fields : {Fields} +-} +data Alt = Alt (Pos) (ConstructorSet ) (Fields) +-- Alts -------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Alt + child tl : Alts + alternative Nil: +-} +type Alts = [Alt ] +-- Attrs ------------------------------------------------------- +{- + alternatives: + alternative Attrs: + child pos : {Pos} + child inh : {AttrNames} + child chn : {AttrNames} + child syn : {AttrNames} +-} +data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames) +-- ConstructorSet ---------------------------------------------- +{- + alternatives: + alternative CAll: + alternative CDifference: + child set1 : ConstructorSet + child set2 : ConstructorSet + alternative CName: + child name : {ConstructorIdent} + alternative CUnion: + child set1 : ConstructorSet + child set2 : ConstructorSet +-} +data ConstructorSet = CAll + | CDifference (ConstructorSet ) (ConstructorSet ) + | CName (ConstructorIdent) + | CUnion (ConstructorSet ) (ConstructorSet ) +-- Elem -------------------------------------------------------- +{- + alternatives: + alternative Attr: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child quants : {[String]} + child attrs : Attrs + alternative Data: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child params : {[Identifier]} + child attrs : Attrs + child alts : Alts + child ext : {Bool} + alternative Deriving: + child pos : {Pos} + child set : NontSet + child classes : {[NontermIdent]} + alternative Module: + child pos : {Pos} + child name : {String} + child exports : {String} + child imports : {String} + alternative Nocatas: + child pos : {Pos} + child set : NontSet + alternative Pragma: + child pos : {Pos} + child names : {[NontermIdent]} + alternative Sem: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child attrs : Attrs + child quants : {[String]} + child alts : SemAlts + alternative Set: + child pos : {Pos} + child name : {NontermIdent} + child merge : {Bool} + child set : NontSet + alternative Txt: + child pos : {Pos} + child name : {Identifier} + child mbNt : {Maybe NontermIdent} + child lines : {[String]} + alternative Type: + child pos : {Pos} + child ctx : {ClassContext} + child name : {NontermIdent} + child params : {[Identifier]} + child type : {ComplexType} + alternative Wrapper: + child pos : {Pos} + child set : NontSet +-} +data Elem = Attr (Pos) (ClassContext) (NontSet ) (([String])) (Attrs ) + | Data (Pos) (ClassContext) (NontSet ) (([Identifier])) (Attrs ) (Alts ) (Bool) + | Deriving (Pos) (NontSet ) (([NontermIdent])) + | Module (Pos) (String) (String) (String) + | Nocatas (Pos) (NontSet ) + | Pragma (Pos) (([NontermIdent])) + | Sem (Pos) (ClassContext) (NontSet ) (Attrs ) (([String])) (SemAlts ) + | Set (Pos) (NontermIdent) (Bool) (NontSet ) + | Txt (Pos) (Identifier) ((Maybe NontermIdent)) (([String])) + | Type (Pos) (ClassContext) (NontermIdent) (([Identifier])) (ComplexType) + | Wrapper (Pos) (NontSet ) +-- Elems ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Elem + child tl : Elems + alternative Nil: +-} +type Elems = [Elem ] +-- NontSet ----------------------------------------------------- +{- + alternatives: + alternative All: + alternative Difference: + child set1 : NontSet + child set2 : NontSet + alternative Intersect: + child set1 : NontSet + child set2 : NontSet + alternative NamedSet: + child name : {NontermIdent} + alternative Path: + child from : {NontermIdent} + child to : {NontermIdent} + alternative Union: + child set1 : NontSet + child set2 : NontSet +-} +data NontSet = All + | Difference (NontSet ) (NontSet ) + | Intersect (NontSet ) (NontSet ) + | NamedSet (NontermIdent) + | Path (NontermIdent) (NontermIdent) + | Union (NontSet ) (NontSet ) +-- SemAlt ------------------------------------------------------ +{- + alternatives: + alternative SemAlt: + child pos : {Pos} + child constructorSet : ConstructorSet + child rules : SemDefs +-} +data SemAlt = SemAlt (Pos) (ConstructorSet ) (SemDefs ) +-- SemAlts ----------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : SemAlt + child tl : SemAlts + alternative Nil: +-} +type SemAlts = [SemAlt ] +-- SemDef ------------------------------------------------------ +{- + alternatives: + alternative AroundDef: + child ident : {Identifier} + child rhs : {Expression} + alternative AttrOrderBefore: + child before : {[Occurrence]} + child after : {[Occurrence]} + alternative AugmentDef: + child ident : {Identifier} + child rhs : {Expression} + alternative Def: + child pos : {Pos} + child mbName : {Maybe Identifier} + child pattern : {Pattern} + child rhs : {Expression} + child owrt : {Bool} + alternative MergeDef: + child target : {Identifier} + child nt : {Identifier} + child sources : {[Identifier]} + child rhs : {Expression} + alternative SemPragma: + child names : {[NontermIdent]} + alternative TypeDef: + child pos : {Pos} + child ident : {Identifier} + child tp : {Type} + alternative UniqueDef: + child ident : {Identifier} + child ref : {Identifier} +-} +data SemDef = AroundDef (Identifier) (Expression) + | AttrOrderBefore (([Occurrence])) (([Occurrence])) + | AugmentDef (Identifier) (Expression) + | Def (Pos) ((Maybe Identifier)) (Pattern) (Expression) (Bool) + | MergeDef (Identifier) (Identifier) (([Identifier])) (Expression) + | SemPragma (([NontermIdent])) + | TypeDef (Pos) (Identifier) (Type) + | UniqueDef (Identifier) (Identifier) +-- SemDefs ----------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : SemDef + child tl : SemDefs + alternative Nil: +-} +type SemDefs = [SemDef ] diff --git a/src-derived/DeclBlocks.hs b/src-derived/DeclBlocks.hs new file mode 100644 --- /dev/null +++ b/src-derived/DeclBlocks.hs @@ -0,0 +1,28 @@ + + +-- UUAGC 0.9.38.1 (DeclBlocks.ag) +module DeclBlocks where +{-# LINE 2 "DeclBlocks.ag" #-} + +import Code (Decl,Expr) +{-# LINE 9 "../src-derived/DeclBlocks.hs" #-} +-- DeclBlocks -------------------------------------------------- +{- + alternatives: + alternative DeclBlock: + child defs : {[Decl]} + child visit : {Decl} + child next : DeclBlocks + alternative DeclTerminator: + child defs : {[Decl]} + child result : {Expr} +-} +data DeclBlocks = DeclBlock (([Decl])) (Decl) (DeclBlocks ) + | DeclTerminator (([Decl])) (Expr) +-- DeclBlocksRoot ---------------------------------------------- +{- + alternatives: + alternative DeclBlocksRoot: + child blocks : DeclBlocks +-} +data DeclBlocksRoot = DeclBlocksRoot (DeclBlocks ) diff --git a/src-derived/DefaultRules.hs b/src-derived/DefaultRules.hs new file mode 100644 --- /dev/null +++ b/src-derived/DefaultRules.hs @@ -0,0 +1,2658 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.38.2 (DefaultRules.ag) +module DefaultRules where +{-# LINE 10 "DefaultRules.ag" #-} + +import qualified List (delete,intersperse) + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import UU.Scanner.Position(noPos) +import Pretty +import Maybe +import HsToken +import HsTokenScanner +import Data.List(intersperse) + +import AbstractSyntax +import ErrorMessages + +import Options(Options,modcopy,rename) +{-# LINE 26 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 2 "./AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 36 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 43 "../src-derived/DefaultRules.hs" #-} +{-# LINE 61 "DefaultRules.ag" #-} + +fieldName n = '@' : getName n + +locName n = '@' : getName n + +attrName fld attr + | fld == _LOC = '@' : getName attr + | otherwise = '@' : getName fld ++ "." ++ getName attr + +_ACHILD = Ident "(" noPos -- hack + + +getConName typeSyns rename nt con1 + | nt `elem` map fst typeSyns = synonym + | otherwise = normalName + where con = getName con1 + normalName | rename = getName nt++"_"++ con + | otherwise = con + synonym | con == "Cons" = "(:)" + | con == "Nil" = case lookup nt typeSyns of + Just (Map _ _) -> "Map.empty" + Just (IntMap _) -> "IntMap.empty" + _ -> "[]" + | con == "Just" = "Just" + | con == "Nothing" = "Nothing" + | con == "Entry" = case lookup nt typeSyns of + Just (Map _ _) -> "Map.insert" + Just (IntMap _) -> "IntMap.insert" + | otherwise = normalName + +concatSeq = foldr (Seq.><) Seq.empty + +splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) +splitAttrs _ [] + = ([],[]) +splitAttrs useMap (n:rest) + = let (uses,normals) = splitAttrs useMap rest + in case Map.lookup n useMap of + Just x -> ((n,x):uses , normals ) + Nothing -> ( uses , n:normals ) + +removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) +removeDefined defined (fld,as) + = ( fld + , [ a + | a <- Map.keys as + , not (Set.member (fld,a) defined) + ] + ) + +{-# LINE 95 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 176 "DefaultRules.ag" #-} + + + + +deprecatedCopyRuleError nt con fld a + = let mesg = + "In the definitions for alternative" + >#< getName con + >#< "of nonterminal" + >#< getName nt + >|< "," + >-< "the value of field" + >#< getName a + >#< "is copied by a copy-rule." + >-< "Copying the value of a field using a copy-rule is deprecated" + >-< "Please add the following lines to your code:" + >-< ( "SEM" + >#< getName nt + >-< indent 2 ( "|" + >#< getName con + >#< getName fld + >#< "." + >#< a + >#< "=" + >#< "@" + >|< a + ) + ) + in CustomError True (getPos a) mesg + + +missingRuleErrorExpr nt con fld a + = "error \"missing rule: " + ++ show nt ++ "." ++ show con ++ "." + ++ show fld ++ "." ++ show a ++ "\"" + + + +makeRule :: (Identifier,Identifier) -> Expression -> String -> Rule +makeRule (f1,a1) expr origin + = Rule Nothing + (Alias f1 a1 (Underscore noPos) []) + expr + False + origin + False + + +useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule +useRule locals ch_outs (n,(op,e,pos)) + = let elems = [ fld + | (fld,as) <- ch_outs + , Map.member n as + ] + + expr | Set.member n locals = attrName _LOC n + | null elems = e + | otherwise = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) + (map (flip attrName n) elems) + + tks | Set.member n locals = [AGLocal n noPos Nothing] + | null elems = lexTokens noPos e + | otherwise = lexTokens noPos str + where + str = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) + (map (flip attrName n) elems) + + in makeRule (_LHS,n) + (Expression noPos tks) + ("use rule " ++ pos) + + + + +selfRule lhsNecLoc attr x + = let expr | lhsNecLoc = locName attr + | otherwise = x + + tks | lhsNecLoc = [AGLocal attr noPos Nothing] + | otherwise = lexTokens noPos x + + in makeRule (if lhsNecLoc then _LHS else _LOC,attr) + (Expression noPos tks) + "self rule" + + + + +concatRE rsess = let (rss,ess) = unzip rsess + in (concat rss, concatSeq ess) + + +copyRule :: Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) +copyRule nt con modcopy locals (env,(fld,as)) + = concatRE (map copyRu as) + + where + copyRu a + = ( [ makeRule (fld,a) + (Expression noPos tks) + (cruletxt sel) + ] + , err + ) + + where + sel + | not modcopy + && Set.member a locals = Just _LOC + | otherwise = Map.lookup a env + + (expr,err) + = case sel of + Nothing -> ( missingRuleErrorExpr nt con fld a + , Seq.singleton (MissingRule nt con fld a) + ) + Just f + | f == _ACHILD -> ( fieldName a + , Seq.singleton (deprecatedCopyRuleError nt con fld a) + ) + | otherwise -> ( attrName f a + , Seq.empty + ) + + (tks,err') + = case sel of + Nothing -> ( [HsToken (missingRuleErrorExpr nt con fld a) noPos] + , Seq.singleton (MissingRule nt con fld a) + ) + Just f + | f == _ACHILD -> ( [AGLocal a noPos Nothing] + , Seq.singleton (deprecatedCopyRuleError nt con fld a) + ) + | otherwise -> ( [AGField f a noPos Nothing] + , Seq.empty + ) + + cruletxt sel + | local = "copy rule (from local)" + | deprChild = "deprecated child copy" + | Set.member a locals && nonlocal = "modified copy rule" + | incoming && outgoing = "copy rule (chain)" + | incoming = "copy rule (down)" + | outgoing = "copy rule (up)" + | otherwise = "copy rule (chain)" + where outgoing = fld == _LHS + incoming = maybe False (== _LHS) sel + nonlocal = maybe False (/= _LOC) sel + local = maybe False (== _LOC) sel + deprChild = maybe False (== _ACHILD) sel +{-# LINE 248 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 407 "DefaultRules.ag" #-} + +addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule] +addAugments (_, exprs) rules + | null exprs = rules +addAugments (syn, exprs) rules + = [rule] ++ funRules ++ map modify rules + where + rule = Rule Nothing (Alias _LHS syn (Underscore noPos) []) rhs False "augmented rule" False + rhs = Expression noPos tks + tks = [ HsToken "foldr ($) " noPos, AGLocal substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] + funs = intersperse (HsToken ", " noPos) (map (\n -> AGLocal n noPos Nothing) funNames) + + substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn) + funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs + funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos) []) expr False "augment function" False) funNames exprs + + modify (Rule mbNm pat rhs owrt origin expl) + | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl + modify r = r + + containsSyn (Constr _ pats) = any containsSyn pats + containsSyn (Product _ pats) = any containsSyn pats + containsSyn (Irrefutable pat) = containsSyn pat + containsSyn (Alias field attr pat parts) = (field == _LHS && attr == syn) || containsSyn pat || any containsSyn parts + containsSyn _ = False + + modifyPat (Constr name pats) = Constr name (map modifyPat pats) + modifyPat (Product pos pats) = Product pos (map modifyPat pats) + modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat) + modifyPat (Alias field attr pat parts) + | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat) (map modifyPat parts) + | otherwise = Alias field attr (modifyPat pat) (map modifyPat parts) + modifyPat p = p + +addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule] +addArounds (_, exprs) rules | null exprs = rules +addArounds (child, exprs) rules + = [rule] ++ funRules ++ rules + where + rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos) []) rhs False "around rule" False + rhs = Expression noPos tks + tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] + funs = intersperse (HsToken ", " noPos) (map (\n -> AGLocal n noPos Nothing) funNames) + + childLoc = Ident (show child ++ "_around") (getPos child) + funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs + funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos) []) expr False "around function" False) funNames exprs + +addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule] +addMerges (target,(_,_,expr)) rules + = rule : rules + where + rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos) []) expr False "merge rule" False + childLoc = Ident (show target ++ "_merge") (getPos target) +{-# LINE 305 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 522 "DefaultRules.ag" #-} + +{- +multiRule replaces + loc.(a,b) = e +by + loc.tup1 = e + loc.(a,_) = @loc.tup1 + loc.(_,b) = @loc.tup1 +It needs to thread a unique number for inventing names for the tuples. + +It also works for nested tuples: + loc.(a,(b,c)) = e +becomes + loc.tup1 = e + loc.(a,_) = @loc.tup1 + loc.(_,tup2) = @loc.tup1 + loc.(b,_) = @loc.tup2 + loc.(_,c) = @loc.tup2 +-} + +multiRule :: Rule -> Int -> ([Rule], Int) +multiRule (Rule (Just nm) pat expr owrt origin expl) uniq + = let pos = getPos nm + r = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos) []) expr owrt origin expl + expr' = Expression pos tks + tks = [AGLocal (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))] + (rs,uniq') = multiRule (Rule Nothing pat expr' owrt origin False) uniq + in (r:rs, uniq') + +multiRule (Rule Nothing pat expr owrt origin expl) uniq + = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) + f expl' w e (Product pos pats) n + = let freshName = Ident ("_tup" ++ show n) pos + freshExpr = Expression pos freshTks + freshTks = [AGField _LOC freshName pos Nothing] + freshPat = Alias _LOC freshName (Underscore pos) pats + a = length pats - 1 + us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) + g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) + g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f False (us (length xs1)) freshExpr p n1 + in (x2:xs1, rs2++rs1, n2) + (xs9,rs9,n9) = foldr g ([], [], n+1) pats + in ( freshPat + , ( Rule Nothing (w freshPat) e owrt origin expl' : rs9 + , n9 + ) + ) + f expl' w e p n + = ( p + , ( [Rule Nothing (w p) e owrt origin expl'] + , n + ) + ) + in snd (f expl id expr pat uniq) + +{-# LINE 363 "../src-derived/DefaultRules.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + cr : Bool + merged : Set Identifier + nt : NontermIdent + synthesized attributes: + errors : Seq Error + field : (Identifier,Type,Maybe (Maybe Type)) + inherited : Attributes + name : Identifier + output : SELF + synthesized : Attributes + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} + visit 0: + local output : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child !(Child _name _tp _inh _syn _virtual ) = + (sem_Child_Child _name _tp _inh _syn _virtual ) +-- semantic domain +newtype T_Child = T_Child (ConstructorIdent -> + Bool -> + (Set Identifier) -> + NontermIdent -> + ( (Seq Error),( (Identifier,Type,Maybe (Maybe Type)) ),Attributes,Identifier,Child ,Attributes)) +data Inh_Child = Inh_Child {con_Inh_Child :: !(ConstructorIdent),cr_Inh_Child :: !(Bool),merged_Inh_Child :: !((Set Identifier)),nt_Inh_Child :: !(NontermIdent)} +data Syn_Child = Syn_Child {errors_Syn_Child :: !((Seq Error)),field_Syn_Child :: !(( (Identifier,Type,Maybe (Maybe Type)) )),inherited_Syn_Child :: !(Attributes),name_Syn_Child :: !(Identifier),output_Syn_Child :: !(Child ),synthesized_Syn_Child :: !(Attributes)} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child !(T_Child sem ) !(Inh_Child _lhsIcon _lhsIcr _lhsImerged _lhsInt ) = + (let ( !_lhsOerrors,!_lhsOfield,!_lhsOinherited,!_lhsOname,!_lhsOoutput,!_lhsOsynthesized) = sem _lhsIcon _lhsIcr _lhsImerged _lhsInt + in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized )) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + (Maybe (Maybe Type)) -> + T_Child +sem_Child_Child !name_ !tp_ !inh_ !syn_ !virtual_ = + (T_Child (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsImerged) + (!_lhsInt) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 421 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 481 "DefaultRules.ag" #-} + (name_,tp_,virtual_) + {-# LINE 426 "DefaultRules.hs" #-} + )) of + { !_lhsOfield -> + (case (({-# LINE 159 "DefaultRules.ag" #-} + inh_ + {-# LINE 431 "DefaultRules.hs" #-} + )) of + { !_lhsOinherited -> + (case (({-# LINE 150 "DefaultRules.ag" #-} + name_ + {-# LINE 436 "DefaultRules.hs" #-} + )) of + { !_lhsOname -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Child name_ tp_ inh_ syn_ virtual_ + {-# LINE 441 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 446 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 160 "DefaultRules.ag" #-} + if name_ `Set.member` _lhsImerged + then Map.empty + else syn_ + {-# LINE 453 "DefaultRules.hs" #-} + )) of + { !_lhsOsynthesized -> + ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) }) }) }) }) }) }) })) ) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + cr : Bool + merged : Set Identifier + nt : NontermIdent + synthesized attributes: + errors : Seq Error + fields : [(Identifier,Type,Maybe (Maybe Type))] + inputs : [(Identifier, Attributes)] + output : SELF + outputs : [(Identifier, Attributes)] + alternatives: + alternative Cons: + child hd : Child + child tl : Children + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children !list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) +-- semantic domain +newtype T_Children = T_Children (ConstructorIdent -> + Bool -> + (Set Identifier) -> + NontermIdent -> + ( (Seq Error),([(Identifier,Type,Maybe (Maybe Type))]),([(Identifier, Attributes)]),Children ,([(Identifier, Attributes)]))) +data Inh_Children = Inh_Children {con_Inh_Children :: !(ConstructorIdent),cr_Inh_Children :: !(Bool),merged_Inh_Children :: !((Set Identifier)),nt_Inh_Children :: !(NontermIdent)} +data Syn_Children = Syn_Children {errors_Syn_Children :: !((Seq Error)),fields_Syn_Children :: !(([(Identifier,Type,Maybe (Maybe Type))])),inputs_Syn_Children :: !(([(Identifier, Attributes)])),output_Syn_Children :: !(Children ),outputs_Syn_Children :: !(([(Identifier, Attributes)]))} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children !(T_Children sem ) !(Inh_Children _lhsIcon _lhsIcr _lhsImerged _lhsInt ) = + (let ( !_lhsOerrors,!_lhsOfields,!_lhsOinputs,!_lhsOoutput,!_lhsOoutputs) = sem _lhsIcon _lhsIcr _lhsImerged _lhsInt + in (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs )) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons !(T_Child hd_ ) !(T_Children tl_ ) = + (T_Children (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsImerged) + (!_lhsInt) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 510 "DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 666 "DefaultRules.ag" #-} + _lhsImerged + {-# LINE 515 "DefaultRules.hs" #-} + )) of + { !_tlOmerged -> + (case (({-# LINE 47 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 520 "DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 525 "DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOcr _tlOmerged _tlOnt ) of + { ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 532 "DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 666 "DefaultRules.ag" #-} + _lhsImerged + {-# LINE 537 "DefaultRules.hs" #-} + )) of + { !_hdOmerged -> + (case (({-# LINE 47 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 542 "DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 547 "DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOcr _hdOmerged _hdOnt ) of + { ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 554 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 477 "DefaultRules.ag" #-} + _hdIfield : _tlIfields + {-# LINE 559 "DefaultRules.hs" #-} + )) of + { !_lhsOfields -> + (case (({-# LINE 165 "DefaultRules.ag" #-} + (_hdIname, _hdIinherited) : _tlIinputs + {-# LINE 564 "DefaultRules.hs" #-} + )) of + { !_lhsOinputs -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 569 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 574 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 166 "DefaultRules.ag" #-} + (_hdIname, _hdIsynthesized) : _tlIoutputs + {-# LINE 579 "DefaultRules.hs" #-} + )) of + { !_lhsOoutputs -> + ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsImerged) + (!_lhsInt) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 591 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 478 "DefaultRules.ag" #-} + [] + {-# LINE 596 "DefaultRules.hs" #-} + )) of + { !_lhsOfields -> + (case (({-# LINE 167 "DefaultRules.ag" #-} + [] + {-# LINE 601 "DefaultRules.hs" #-} + )) of + { !_lhsOinputs -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 606 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 611 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 168 "DefaultRules.ag" #-} + [] + {-# LINE 616 "DefaultRules.hs" #-} + )) of + { !_lhsOoutputs -> + ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) })) ) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + visit 0: + local output : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( (Seq Error),Grammar )) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: !(Options)} +data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: !((Seq Error)),output_Syn_Grammar :: !(Grammar )} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar !(T_Grammar sem ) !(Inh_Grammar _lhsIoptions ) = + (let ( !_lhsOerrors,!_lhsOoutput) = sem _lhsIoptions + in (Syn_Grammar _lhsOerrors _lhsOoutput )) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ = + (T_Grammar (\ (!_lhsIoptions) -> + (case (({-# LINE 668 "DefaultRules.ag" #-} + mergeMap_ + {-# LINE 682 "DefaultRules.hs" #-} + )) of + { !_nontsOmergesIn -> + (case (({-# LINE 587 "DefaultRules.ag" #-} + manualAttrOrderMap_ + {-# LINE 687 "DefaultRules.hs" #-} + )) of + { !_nontsOmanualAttrOrderMap -> + (case (({-# LINE 154 "DefaultRules.ag" #-} + typeSyns_ + {-# LINE 692 "DefaultRules.hs" #-} + )) of + { !_nontsOtypeSyns -> + (case (({-# LINE 152 "DefaultRules.ag" #-} + useMap_ + {-# LINE 697 "DefaultRules.hs" #-} + )) of + { !_nontsOuseMap -> + (case (({-# LINE 50 "DefaultRules.ag" #-} + modcopy _lhsIoptions + {-# LINE 702 "DefaultRules.hs" #-} + )) of + { !_nontsOcr -> + (case (({-# LINE 49 "DefaultRules.ag" #-} + rename _lhsIoptions + {-# LINE 707 "DefaultRules.hs" #-} + )) of + { !_nontsOo_rename -> + (case (nonts_ ) of + { ( !_nontsIcollect_nts,!T_Nonterminals_1 nonts_1) -> + (case (({-# LINE 660 "DefaultRules.ag" #-} + aroundsMap_ + {-# LINE 714 "DefaultRules.hs" #-} + )) of + { !_nontsOaroundsIn -> + (case (({-# LINE 653 "DefaultRules.ag" #-} + augmentsMap_ + {-# LINE 719 "DefaultRules.hs" #-} + )) of + { !_nontsOaugmentsIn -> + (case (({-# LINE 498 "DefaultRules.ag" #-} + 1 + {-# LINE 724 "DefaultRules.hs" #-} + )) of + { !_nontsOuniq -> + (case (({-# LINE 131 "DefaultRules.ag" #-} + _nontsIcollect_nts + {-# LINE 729 "DefaultRules.hs" #-} + )) of + { !_nontsOnonterminals -> + (case (nonts_1 _nontsOaroundsIn _nontsOaugmentsIn _nontsOcr _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap ) of + { ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _nontsIerrors + {-# LINE 736 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ + {-# LINE 741 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 746 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + synthesized attribute: + collect_nts : Set NontermIdent + visit 1: + inherited attributes: + aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cr : Bool + manualAttrOrderMap : AttrOrderMap + mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) + nonterminals : Set NontermIdent + o_rename : Bool + typeSyns : TypeSyns + useMap : UseMap + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 1: + local mergesIn : _ + local augmentsIn : _ + local aroundsIn : _ + local output : _ +-} +-- cata +sem_Nonterminal :: Nonterminal -> + T_Nonterminal +sem_Nonterminal !(Nonterminal _nt _params _inh _syn _prods ) = + (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) +-- semantic domain +newtype T_Nonterminal = T_Nonterminal (( (Set NontermIdent),T_Nonterminal_1 )) +newtype T_Nonterminal_1 = T_Nonterminal_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + Bool -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> + (Set NontermIdent) -> + Bool -> + TypeSyns -> + Int -> + UseMap -> + ( (Seq Error),Nonterminal ,Int)) +data Inh_Nonterminal = Inh_Nonterminal {aroundsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminal :: !(Bool),manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap),mergesIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),nonterminals_Inh_Nonterminal :: !((Set NontermIdent)),o_rename_Inh_Nonterminal :: !(Bool),typeSyns_Inh_Nonterminal :: !(TypeSyns),uniq_Inh_Nonterminal :: !(Int),useMap_Inh_Nonterminal :: !(UseMap)} +data Syn_Nonterminal = Syn_Nonterminal {collect_nts_Syn_Nonterminal :: !((Set NontermIdent)),errors_Syn_Nonterminal :: !((Seq Error)),output_Syn_Nonterminal :: !(Nonterminal ),uniq_Syn_Nonterminal :: !(Int)} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = + (let ( !_lhsOcollect_nts,!T_Nonterminal_1 sem_1) = sem + ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap + in (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq )) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_ ) = + (T_Nonterminal (case (({-# LINE 127 "DefaultRules.ag" #-} + Set.singleton nt_ + {-# LINE 820 "DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case ((let sem_Nonterminal_Nonterminal_1 :: T_Nonterminal_1 + sem_Nonterminal_Nonterminal_1 = + (T_Nonterminal_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 837 "DefaultRules.hs" #-} + )) of + { !_prodsOtypeSyns -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 842 "DefaultRules.hs" #-} + )) of + { !_prodsOo_rename -> + (case (({-# LINE 669 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergesIn + {-# LINE 847 "DefaultRules.hs" #-} + )) of + { !_mergesIn -> + (case (({-# LINE 665 "DefaultRules.ag" #-} + _mergesIn + {-# LINE 852 "DefaultRules.hs" #-} + )) of + { !_prodsOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 857 "DefaultRules.hs" #-} + )) of + { !_prodsOmanualAttrOrderMap -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 862 "DefaultRules.hs" #-} + )) of + { !_prodsOcr -> + (case (({-# LINE 156 "DefaultRules.ag" #-} + nt_ + {-# LINE 867 "DefaultRules.hs" #-} + )) of + { !_prodsOnt -> + (case (({-# LINE 144 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIuseMap + {-# LINE 872 "DefaultRules.hs" #-} + )) of + { !_prodsOuseMap -> + (case (({-# LINE 143 "DefaultRules.ag" #-} + syn_ + {-# LINE 877 "DefaultRules.hs" #-} + )) of + { !_prodsOsyn -> + (case (({-# LINE 142 "DefaultRules.ag" #-} + inh_ + {-# LINE 882 "DefaultRules.hs" #-} + )) of + { !_prodsOinh -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 887 "DefaultRules.hs" #-} + )) of + { !_prodsOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 892 "DefaultRules.hs" #-} + )) of + { !_prodsOnonterminals -> + (case (({-# LINE 654 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn + {-# LINE 897 "DefaultRules.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 651 "DefaultRules.ag" #-} + _augmentsIn + {-# LINE 902 "DefaultRules.hs" #-} + )) of + { !_prodsOaugmentsIn -> + (case (({-# LINE 661 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundsIn + {-# LINE 907 "DefaultRules.hs" #-} + )) of + { !_aroundsIn -> + (case (({-# LINE 658 "DefaultRules.ag" #-} + _aroundsIn + {-# LINE 912 "DefaultRules.hs" #-} + )) of + { !_prodsOaroundsIn -> + (case (prods_ _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap ) of + { ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _prodsIerrors + {-# LINE 919 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Nonterminal nt_ params_ inh_ syn_ _prodsIoutput + {-# LINE 924 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 929 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _prodsIuniq + {-# LINE 934 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Nonterminal_Nonterminal_1)) of + { ( !sem_Nonterminal_1) -> + ( _lhsOcollect_nts,sem_Nonterminal_1) }) }) ) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + synthesized attribute: + collect_nts : Set NontermIdent + visit 1: + inherited attributes: + aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cr : Bool + manualAttrOrderMap : AttrOrderMap + mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) + nonterminals : Set NontermIdent + o_rename : Bool + typeSyns : TypeSyns + useMap : UseMap + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + visit 1: + local output : _ + alternative Nil: + visit 1: + local output : _ +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals !list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals (( (Set NontermIdent),T_Nonterminals_1 )) +newtype T_Nonterminals_1 = T_Nonterminals_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + Bool -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> + (Set NontermIdent) -> + Bool -> + TypeSyns -> + Int -> + UseMap -> + ( (Seq Error),Nonterminals ,Int)) +data Inh_Nonterminals = Inh_Nonterminals {aroundsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminals :: !(Bool),manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap),mergesIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),nonterminals_Inh_Nonterminals :: !((Set NontermIdent)),o_rename_Inh_Nonterminals :: !(Bool),typeSyns_Inh_Nonterminals :: !(TypeSyns),uniq_Inh_Nonterminals :: !(Int),useMap_Inh_Nonterminals :: !(UseMap)} +data Syn_Nonterminals = Syn_Nonterminals {collect_nts_Syn_Nonterminals :: !((Set NontermIdent)),errors_Syn_Nonterminals :: !((Seq Error)),output_Syn_Nonterminals :: !(Nonterminals ),uniq_Syn_Nonterminals :: !(Int)} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = + (let ( !_lhsOcollect_nts,!T_Nonterminals_1 sem_1) = sem + ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap + in (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq )) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons !(T_Nonterminal hd_ ) !(T_Nonterminals tl_ ) = + (T_Nonterminals (case (tl_ ) of + { ( !_tlIcollect_nts,!T_Nonterminals_1 tl_1) -> + (case (hd_ ) of + { ( !_hdIcollect_nts,!T_Nonterminal_1 hd_1) -> + (case (({-# LINE 125 "DefaultRules.ag" #-} + _hdIcollect_nts `Set.union` _tlIcollect_nts + {-# LINE 1009 "DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case ((let sem_Nonterminals_Cons_1 :: T_Nonterminals_1 + sem_Nonterminals_Cons_1 = + (T_Nonterminals_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 138 "DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 1026 "DefaultRules.hs" #-} + )) of + { !_tlOuseMap -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 1031 "DefaultRules.hs" #-} + )) of + { !_tlOtypeSyns -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 1036 "DefaultRules.hs" #-} + )) of + { !_tlOo_rename -> + (case (({-# LINE 664 "DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 1041 "DefaultRules.hs" #-} + )) of + { !_tlOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 1046 "DefaultRules.hs" #-} + )) of + { !_tlOmanualAttrOrderMap -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1051 "DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 138 "DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 1056 "DefaultRules.hs" #-} + )) of + { !_hdOuseMap -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 1061 "DefaultRules.hs" #-} + )) of + { !_hdOtypeSyns -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 1066 "DefaultRules.hs" #-} + )) of + { !_hdOo_rename -> + (case (({-# LINE 664 "DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 1071 "DefaultRules.hs" #-} + )) of + { !_hdOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 1076 "DefaultRules.hs" #-} + )) of + { !_hdOmanualAttrOrderMap -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1081 "DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1086 "DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 1091 "DefaultRules.hs" #-} + )) of + { !_hdOnonterminals -> + (case (({-# LINE 650 "DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 1096 "DefaultRules.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (({-# LINE 657 "DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 1101 "DefaultRules.hs" #-} + )) of + { !_hdOaroundsIn -> + (case (hd_1 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap ) of + { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _hdIuniq + {-# LINE 1108 "DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 1113 "DefaultRules.hs" #-} + )) of + { !_tlOnonterminals -> + (case (({-# LINE 650 "DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 1118 "DefaultRules.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (({-# LINE 657 "DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 1123 "DefaultRules.hs" #-} + )) of + { !_tlOaroundsIn -> + (case (tl_1 _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap ) of + { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1130 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1135 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1140 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _tlIuniq + {-# LINE 1145 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Nonterminals_Cons_1)) of + { ( !sem_Nonterminals_1) -> + ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) }) }) ) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (case (({-# LINE 125 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1156 "DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case ((let sem_Nonterminals_Nil_1 :: T_Nonterminals_1 + sem_Nonterminals_Nil_1 = + (T_Nonterminals_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 1173 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 1178 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1183 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1188 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) })) ) + in sem_Nonterminals_Nil_1)) of + { ( !sem_Nonterminals_1) -> + ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + synthesized attributes: + containsVars : Bool + copy : SELF + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : SELF + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + local output : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local output : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + local output : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local output : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ + local output : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern !(Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern !(Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern !(Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern !(Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern !(Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (ConstructorIdent -> + NontermIdent -> + ( Bool,Pattern ,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Pattern )) +data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: !(ConstructorIdent),nt_Inh_Pattern :: !(NontermIdent)} +data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: !(Bool),copy_Syn_Pattern :: !(Pattern ),definedAttrs_Syn_Pattern :: !((Set (Identifier,Identifier))),errors_Syn_Pattern :: !((Seq Error)),locals_Syn_Pattern :: !((Set Identifier)),output_Syn_Pattern :: !(Pattern )} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern !(T_Pattern sem ) !(Inh_Pattern _lhsIcon _lhsInt ) = + (let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = sem _lhsIcon _lhsInt + in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 489 "DefaultRules.ag" #-} + True + {-# LINE 1275 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1280 "DefaultRules.hs" #-} + )) of + { !_partsOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1285 "DefaultRules.hs" #-} + )) of + { !_partsOcon -> + (case (parts_ _partsOcon _partsOnt ) of + { ( !_partsIcontainsVars,!_partsIcopy,!_partsIdefinedAttrs,!_partsIerrors,!_partsIlocals,!_partsIoutput) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1292 "DefaultRules.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1297 "DefaultRules.hs" #-} + )) of + { !_patOcon -> + (case (pat_ _patOcon _patOnt ) of + { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 1304 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1309 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 471 "DefaultRules.ag" #-} + Set.insert (field_,attr_) _patIdefinedAttrs + {-# LINE 1314 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patIerrors Seq.>< _partsIerrors + {-# LINE 1319 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 472 "DefaultRules.ag" #-} + if field_ == _LOC + then Set.insert attr_ _patIlocals + else _patIlocals + {-# LINE 1326 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Alias field_ attr_ _patIoutput _partsIoutput + {-# LINE 1331 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1336 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_ ) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1348 "DefaultRules.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1353 "DefaultRules.hs" #-} + )) of + { !_patsOcon -> + (case (pats_ _patsOcon _patsOnt ) of + { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _patsIcontainsVars + {-# LINE 1360 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1365 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1370 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _patsIdefinedAttrs + {-# LINE 1375 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patsIerrors + {-# LINE 1380 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _patsIlocals + {-# LINE 1385 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Constr name_ _patsIoutput + {-# LINE 1390 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1395 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_ ) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1406 "DefaultRules.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1411 "DefaultRules.hs" #-} + )) of + { !_patOcon -> + (case (pat_ _patOcon _patOnt ) of + { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _patIcontainsVars + {-# LINE 1418 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1423 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1428 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _patIdefinedAttrs + {-# LINE 1433 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patIerrors + {-# LINE 1438 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _patIlocals + {-# LINE 1443 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Irrefutable _patIoutput + {-# LINE 1448 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1453 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_ ) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1465 "DefaultRules.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1470 "DefaultRules.hs" #-} + )) of + { !_patsOcon -> + (case (pats_ _patsOcon _patsOnt ) of + { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _patsIcontainsVars + {-# LINE 1477 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1482 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1487 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _patsIdefinedAttrs + {-# LINE 1492 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patsIerrors + {-# LINE 1497 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _patsIlocals + {-# LINE 1502 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Product pos_ _patsIoutput + {-# LINE 1507 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1512 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + False + {-# LINE 1523 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 1528 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1533 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1538 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 1543 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1548 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Underscore pos_ + {-# LINE 1553 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1558 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) })) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + synthesized attributes: + containsVars : Bool + copy : SELF + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : SELF + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + local output : _ + alternative Nil: + visit 0: + local copy : _ + local output : _ +-} +-- cata +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 (ConstructorIdent -> + NontermIdent -> + ( Bool,Patterns ,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Patterns )) +data Inh_Patterns = Inh_Patterns {con_Inh_Patterns :: !(ConstructorIdent),nt_Inh_Patterns :: !(NontermIdent)} +data Syn_Patterns = Syn_Patterns {containsVars_Syn_Patterns :: !(Bool),copy_Syn_Patterns :: !(Patterns ),definedAttrs_Syn_Patterns :: !((Set (Identifier,Identifier))),errors_Syn_Patterns :: !((Seq Error)),locals_Syn_Patterns :: !((Set Identifier)),output_Syn_Patterns :: !(Patterns )} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns !(T_Patterns sem ) !(Inh_Patterns _lhsIcon _lhsInt ) = + (let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = sem _lhsIcon _lhsInt + in (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons !(T_Pattern hd_ ) !(T_Patterns tl_ ) = + (T_Patterns (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1612 "DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1617 "DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOnt ) of + { ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1624 "DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1629 "DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOnt ) of + { ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _hdIcontainsVars || _tlIcontainsVars + {-# LINE 1636 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1641 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1646 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs + {-# LINE 1651 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1656 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _hdIlocals `Set.union` _tlIlocals + {-# LINE 1661 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1666 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1671 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + False + {-# LINE 1681 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 1686 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1691 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1696 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 1701 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1706 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 1711 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1716 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) })) ) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + cr : Bool + inh : Attributes + manualAttrOrderMap : AttrOrderMap + mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) + nonterminals : Set NontermIdent + nt : NontermIdent + o_rename : Bool + syn : Attributes + typeSyns : TypeSyns + useMap : Map Identifier (String,String,String) + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + visit 0: + local mergesIn : _ + local merged : _ + local orderDeps : _ + local orderErrs : _ + local _tup1 : _ + local errs : _ + local aroundsIn : _ + local augmentsIn : _ + local newRls : _ + local extra1 : _ + local extra2 : _ + local extra3 : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production !(Production _con _children _rules _typeSigs ) = + (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) +-- semantic domain +newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + Bool -> + Attributes -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> + (Set NontermIdent) -> + NontermIdent -> + Bool -> + Attributes -> + TypeSyns -> + Int -> + (Map Identifier (String,String,String)) -> + ( (Seq Error),Production ,Int)) +data Inh_Production = Inh_Production {aroundsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Production :: !(Bool),inh_Inh_Production :: !(Attributes),manualAttrOrderMap_Inh_Production :: !(AttrOrderMap),mergesIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),nonterminals_Inh_Production :: !((Set NontermIdent)),nt_Inh_Production :: !(NontermIdent),o_rename_Inh_Production :: !(Bool),syn_Inh_Production :: !(Attributes),typeSyns_Inh_Production :: !(TypeSyns),uniq_Inh_Production :: !(Int),useMap_Inh_Production :: !((Map Identifier (String,String,String)))} +data Syn_Production = Syn_Production {errors_Syn_Production :: !((Seq Error)),output_Syn_Production :: !(Production ),uniq_Syn_Production :: !(Int)} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production !(T_Production sem ) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = + (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap + in (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq )) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production !con_ !(T_Children children_ ) !(T_Rules rules_ ) !(T_TypeSigs typeSigs_ ) = + (T_Production (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 670 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergesIn + {-# LINE 1810 "DefaultRules.hs" #-} + )) of + { !_mergesIn -> + (case (({-# LINE 671 "DefaultRules.ag" #-} + Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] + {-# LINE 1815 "DefaultRules.hs" #-} + )) of + { !_merged -> + (case (({-# LINE 666 "DefaultRules.ag" #-} + _merged + {-# LINE 1820 "DefaultRules.hs" #-} + )) of + { !_childrenOmerged -> + (case (({-# LINE 597 "DefaultRules.ag" #-} + Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap + {-# LINE 1825 "DefaultRules.hs" #-} + )) of + { !_orderDeps -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1830 "DefaultRules.hs" #-} + )) of + { !_rulesOuniq -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1835 "DefaultRules.hs" #-} + )) of + { !_rulesOnt -> + (case (({-# LINE 147 "DefaultRules.ag" #-} + con_ + {-# LINE 1840 "DefaultRules.hs" #-} + )) of + { !_rulesOcon -> + (case (rules_ _rulesOcon _rulesOnt _rulesOuniq ) of + { ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIruleNames,!_rulesIuniq) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1847 "DefaultRules.hs" #-} + )) of + { !_childrenOnt -> + (case (({-# LINE 47 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1852 "DefaultRules.hs" #-} + )) of + { !_childrenOcr -> + (case (({-# LINE 148 "DefaultRules.ag" #-} + con_ + {-# LINE 1857 "DefaultRules.hs" #-} + )) of + { !_childrenOcon -> + (case (children_ _childrenOcon _childrenOcr _childrenOmerged _childrenOnt ) of + { ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) -> + (case (({-# LINE 599 "DefaultRules.ag" #-} + let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] + chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] + isInAttribute :: Identifier -> Identifier -> [Error] + isInAttribute fld nm + | fld == _LOC = if nm `Set.member` _rulesIlocals + then [] + else [UndefAttr _lhsInt con_ fld nm False] + | fld == _LHS = if nm `Map.member` _lhsIinh + then [] + else [UndefAttr _lhsInt con_ fld nm False] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) + then [] + else [UndefAttr _lhsInt con_ fld nm False] + isOutAttribute :: Identifier -> Identifier -> [Error] + isOutAttribute fld nm + | fld == _LOC = if nm `Set.member` _rulesIlocals + then [] + else [UndefAttr _lhsInt con_ fld nm True] + | fld == _LHS = if nm `Map.member` _lhsIsyn + then [] + else [UndefAttr _lhsInt con_ fld nm True] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) + then [] + else [UndefAttr _lhsInt con_ fld nm True] + existsRule nm = if nm `Set.member` _rulesIruleNames + then [] + else [MissingNamedRule _lhsInt con_ nm] + checkIn (OccAttr fld nm) = isInAttribute fld nm + checkIn (OccRule nm) = existsRule nm + checkOut (OccAttr fld nm) = isOutAttribute fld nm + checkOut (OccRule nm) = existsRule nm + in Seq.fromList . concat $ + [ checkIn occA ++ checkOut occB + | (Dependency occA occB) <- _orderDeps + ] + {-# LINE 1898 "DefaultRules.hs" #-} + )) of + { !_orderErrs -> + (case (({-# LINE 336 "DefaultRules.ag" #-} + let locals = _rulesIlocals + initenv = Map.fromList ( [ (a,_ACHILD) + | (a,_,_) <- _childrenIfields + ] + ++ attrs(_LHS, _lhsIinh) + ++ [ (a,_LOC) + | a <- Set.toList locals + ] + ) + attrs (n,as) = [ (a,n) | a <- Map.keys as ] + envs = scanl (flip Map.union) + initenv + (map (Map.fromList . attrs ) _childrenIoutputs) + child_envs = init envs + lhs_env = last envs + (selfAttrs, normalAttrs) + = Map.partition isSELFNonterminal _lhsIsyn + (_,undefAttrs) + = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) + (useAttrs,others) + = splitAttrs _lhsIuseMap undefAttrs + (rules1, errors1) + = concatRE $ map (copyRule _lhsInt con_ _lhsIcr locals) + (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) + uRules + = map (useRule locals _childrenIoutputs) useAttrs + selfLocRules + = [ selfRule False attr (constructor [childSelf attr nm tp | (nm,tp,virt) <- _childrenIfields, childExists virt]) + | attr <- Map.keys selfAttrs + , not (Set.member attr locals) + ] + where + childSelf self nm tp + = case tp of NT nt _ -> attrName nm self + _ | nm `Set.member` locals -> locname nm + | otherwise -> fieldName nm + constructor fs + | getName con_ == "Tuple" && _lhsInt `elem` map fst _lhsItypeSyns + = "(" ++ concat (List.intersperse "," fs) ++ ")" + | otherwise + = getConName _lhsItypeSyns _lhsIo_rename _lhsInt con_ ++ " " ++ unwords fs + childExists Nothing = True + childExists (Just (Just _)) = True + childExists (Just Nothing) = False + selfRules + = [ selfRule True attr undefined + | attr <- Map.keys selfAttrs + , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) + ] + (rules5, errs5) + = copyRule _lhsInt + con_ + _lhsIcr + locals + (lhs_env, (_LHS, others)) + in (uRules++selfLocRules++selfRules++rules5++rules1, errors1> + (case (({-# LINE 336 "DefaultRules.ag" #-} + __tup1 + {-# LINE 1963 "DefaultRules.hs" #-} + )) of + { !(_,!_errs) -> + (case (({-# LINE 334 "DefaultRules.ag" #-} + _childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs + {-# LINE 1968 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 662 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaroundsIn + {-# LINE 1973 "DefaultRules.hs" #-} + )) of + { !_aroundsIn -> + (case (({-# LINE 655 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaugmentsIn + {-# LINE 1978 "DefaultRules.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 336 "DefaultRules.ag" #-} + __tup1 + {-# LINE 1983 "DefaultRules.hs" #-} + )) of + { !(!_newRls,_) -> + (case (({-# LINE 509 "DefaultRules.ag" #-} + foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn ) + {-# LINE 1988 "DefaultRules.hs" #-} + )) of + { !_extra1 -> + (case (({-# LINE 510 "DefaultRules.ag" #-} + foldr addArounds _extra1 (Map.assocs _aroundsIn ) + {-# LINE 1993 "DefaultRules.hs" #-} + )) of + { !_extra2 -> + (case (({-# LINE 511 "DefaultRules.ag" #-} + foldr addMerges _extra2 (Map.assocs _mergesIn ) + {-# LINE 1998 "DefaultRules.hs" #-} + )) of + { !_extra3 -> + (case (typeSigs_ ) of + { ( !_typeSigsIoutput) -> + (case (({-# LINE 512 "DefaultRules.ag" #-} + Production con_ _childrenIoutput _extra3 _typeSigsIoutput + {-# LINE 2005 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _rulesIuniq + {-# LINE 2010 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + cr : Bool + inh : Attributes + manualAttrOrderMap : AttrOrderMap + mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) + nonterminals : Set NontermIdent + nt : NontermIdent + o_rename : Bool + syn : Attributes + typeSyns : TypeSyns + useMap : Map Identifier (String,String,String) + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions !list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) +-- semantic domain +newtype T_Productions = T_Productions ((Map ConstructorIdent (Map Identifier [Expression])) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + Bool -> + Attributes -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> + (Set NontermIdent) -> + NontermIdent -> + Bool -> + Attributes -> + TypeSyns -> + Int -> + (Map Identifier (String,String,String)) -> + ( (Seq Error),Productions ,Int)) +data Inh_Productions = Inh_Productions {aroundsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Productions :: !(Bool),inh_Inh_Productions :: !(Attributes),manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap),mergesIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),nonterminals_Inh_Productions :: !((Set NontermIdent)),nt_Inh_Productions :: !(NontermIdent),o_rename_Inh_Productions :: !(Bool),syn_Inh_Productions :: !(Attributes),typeSyns_Inh_Productions :: !(TypeSyns),uniq_Inh_Productions :: !(Int),useMap_Inh_Productions :: !((Map Identifier (String,String,String)))} +data Syn_Productions = Syn_Productions {errors_Syn_Productions :: !((Seq Error)),output_Syn_Productions :: !(Productions ),uniq_Syn_Productions :: !(Int)} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions !(T_Productions sem ) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = + (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap + in (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq )) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons !(T_Production hd_ ) !(T_Productions tl_ ) = + (T_Productions (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 2092 "DefaultRules.hs" #-} + )) of + { !_tlOuseMap -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 2097 "DefaultRules.hs" #-} + )) of + { !_tlOtypeSyns -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIsyn + {-# LINE 2102 "DefaultRules.hs" #-} + )) of + { !_tlOsyn -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 2107 "DefaultRules.hs" #-} + )) of + { !_tlOo_rename -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2112 "DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 665 "DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 2117 "DefaultRules.hs" #-} + )) of + { !_tlOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 2122 "DefaultRules.hs" #-} + )) of + { !_tlOmanualAttrOrderMap -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIinh + {-# LINE 2127 "DefaultRules.hs" #-} + )) of + { !_tlOinh -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 2132 "DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 2137 "DefaultRules.hs" #-} + )) of + { !_hdOuseMap -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 2142 "DefaultRules.hs" #-} + )) of + { !_hdOtypeSyns -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIsyn + {-# LINE 2147 "DefaultRules.hs" #-} + )) of + { !_hdOsyn -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 2152 "DefaultRules.hs" #-} + )) of + { !_hdOo_rename -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2157 "DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 665 "DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 2162 "DefaultRules.hs" #-} + )) of + { !_hdOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 2167 "DefaultRules.hs" #-} + )) of + { !_hdOmanualAttrOrderMap -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIinh + {-# LINE 2172 "DefaultRules.hs" #-} + )) of + { !_hdOinh -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 2177 "DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2182 "DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 2187 "DefaultRules.hs" #-} + )) of + { !_hdOnonterminals -> + (case (({-# LINE 651 "DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 2192 "DefaultRules.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (({-# LINE 658 "DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 2197 "DefaultRules.hs" #-} + )) of + { !_hdOaroundsIn -> + (case (hd_ _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap ) of + { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _hdIuniq + {-# LINE 2204 "DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 2209 "DefaultRules.hs" #-} + )) of + { !_tlOnonterminals -> + (case (({-# LINE 651 "DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 2214 "DefaultRules.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (({-# LINE 658 "DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 2219 "DefaultRules.hs" #-} + )) of + { !_tlOaroundsIn -> + (case (tl_ _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap ) of + { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2226 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2231 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2236 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _tlIuniq + {-# LINE 2241 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 2262 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 2267 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2272 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2277 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) })) ) +-- Rule -------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + chained attribute: + uniq : Int + synthesized attributes: + containsVars : Bool + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : SELF + outputs : Rules + ruleNames : Set Identifier + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + visit 0: + local output : _ + local _tup2 : {(Rules,Int)} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit ) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern ) _rhs _owrt _origin _explicit ) +-- semantic domain +newtype T_Rule = T_Rule (ConstructorIdent -> + NontermIdent -> + Int -> + ( Bool,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rule ,Rules ,(Set Identifier),Int)) +data Inh_Rule = Inh_Rule {con_Inh_Rule :: !(ConstructorIdent),nt_Inh_Rule :: !(NontermIdent),uniq_Inh_Rule :: !(Int)} +data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: !(Bool),definedAttrs_Syn_Rule :: !((Set (Identifier,Identifier))),errors_Syn_Rule :: !((Seq Error)),locals_Syn_Rule :: !((Set Identifier)),output_Syn_Rule :: !(Rule ),outputs_Syn_Rule :: !(Rules ),ruleNames_Syn_Rule :: !((Set Identifier)),uniq_Syn_Rule :: !(Int)} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule !(T_Rule sem ) !(Inh_Rule _lhsIcon _lhsInt _lhsIuniq ) = + (let ( !_lhsOcontainsVars,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOoutputs,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIuniq + in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq )) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + Expression -> + Bool -> + String -> + Bool -> + T_Rule +sem_Rule_Rule !mbName_ !(T_Pattern pattern_ ) !rhs_ !owrt_ !origin_ !explicit_ = + (T_Rule (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2340 "DefaultRules.hs" #-} + )) of + { !_patternOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 2345 "DefaultRules.hs" #-} + )) of + { !_patternOcon -> + (case (pattern_ _patternOcon _patternOnt ) of + { ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _patternIcontainsVars + {-# LINE 2352 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _patternIdefinedAttrs + {-# LINE 2357 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patternIerrors + {-# LINE 2362 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _patternIlocals + {-# LINE 2367 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ + {-# LINE 2372 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2377 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 519 "DefaultRules.ag" #-} + multiRule _output _lhsIuniq + {-# LINE 2382 "DefaultRules.hs" #-} + )) of + { !__tup2 -> + (case (({-# LINE 519 "DefaultRules.ag" #-} + __tup2 + {-# LINE 2387 "DefaultRules.hs" #-} + )) of + { !(!_lhsOoutputs,_) -> + (case (({-# LINE 591 "DefaultRules.ag" #-} + case mbName_ of + Nothing -> Set.empty + Just nm -> Set.singleton nm + {-# LINE 2394 "DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 519 "DefaultRules.ag" #-} + __tup2 + {-# LINE 2399 "DefaultRules.hs" #-} + )) of + { !(_,!_lhsOuniq) -> + ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Rules ------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + chained attribute: + uniq : Int + synthesized attributes: + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : SELF + ruleNames : Set Identifier + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules !list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) +-- semantic domain +newtype T_Rules = T_Rules (ConstructorIdent -> + NontermIdent -> + Int -> + ( (Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rules ,(Set Identifier),Int)) +data Inh_Rules = Inh_Rules {con_Inh_Rules :: !(ConstructorIdent),nt_Inh_Rules :: !(NontermIdent),uniq_Inh_Rules :: !(Int)} +data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: !((Set (Identifier,Identifier))),errors_Syn_Rules :: !((Seq Error)),locals_Syn_Rules :: !((Set Identifier)),output_Syn_Rules :: !(Rules ),ruleNames_Syn_Rules :: !((Set Identifier)),uniq_Syn_Rules :: !(Int)} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules !(T_Rules sem ) !(Inh_Rules _lhsIcon _lhsInt _lhsIuniq ) = + (let ( !_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIuniq + in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq )) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons !(T_Rule hd_ ) !(T_Rules tl_ ) = + (T_Rules (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2452 "DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2457 "DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 2462 "DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOnt _hdOuniq ) of + { ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIruleNames,!_hdIuniq) -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _hdIuniq + {-# LINE 2469 "DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2474 "DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 2479 "DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOnt _tlOuniq ) of + { ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIruleNames,!_tlIuniq) -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs + {-# LINE 2486 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2491 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _hdIlocals `Set.union` _tlIlocals + {-# LINE 2496 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 515 "DefaultRules.ag" #-} + if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput + {-# LINE 2501 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 589 "DefaultRules.ag" #-} + _hdIruleNames `Set.union` _tlIruleNames + {-# LINE 2506 "DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _tlIuniq + {-# LINE 2511 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + Set.empty + {-# LINE 2522 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 2527 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + Set.empty + {-# LINE 2532 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 2537 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2542 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 589 "DefaultRules.ag" #-} + Set.empty + {-# LINE 2547 "DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2552 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) })) ) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : SELF + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} + visit 0: + local output : _ +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig !(TypeSig _name _tp ) = + (sem_TypeSig_TypeSig _name _tp ) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( TypeSig )) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig )} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig !(T_TypeSig sem ) !(Inh_TypeSig ) = + (let ( !_lhsOoutput) = sem + in (Syn_TypeSig _lhsOoutput )) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig !name_ !tp_ = + (T_TypeSig (case (({-# LINE 502 "DefaultRules.ag" #-} + TypeSig name_ tp_ + {-# LINE 2589 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2594 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) ) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : SELF + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs !list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( TypeSigs )) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs )} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs !(T_TypeSigs sem ) !(Inh_TypeSigs ) = + (let ( !_lhsOoutput) = sem + in (Syn_TypeSigs _lhsOoutput )) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons !(T_TypeSig hd_ ) !(T_TypeSigs tl_ ) = + (T_TypeSigs (case (tl_ ) of + { ( !_tlIoutput) -> + (case (hd_ ) of + { ( !_hdIoutput) -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2638 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2643 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) }) ) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 2651 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2656 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) ) diff --git a/src-derived/Desugar.hs b/src-derived/Desugar.hs new file mode 100644 --- /dev/null +++ b/src-derived/Desugar.hs @@ -0,0 +1,2811 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.38.1 (Desugar.ag) +module Desugar where +{-# LINE 13 "Desugar.ag" #-} + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import UU.Scanner.Position(Pos(..)) +import Maybe +import Data.List(intersperse) + +import AbstractSyntax +import ErrorMessages +import Options +import HsToken +import HsTokenScanner +import TokenDef +import CommonTypes +{-# LINE 24 "../src-derived/Desugar.hs" #-} + +{-# LINE 2 "./AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 34 "../src-derived/Desugar.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 41 "../src-derived/Desugar.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 47 "../src-derived/Desugar.hs" #-} + +{-# LINE 2 "./HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 53 "../src-derived/Desugar.hs" #-} +{-# LINE 97 "Desugar.ag" #-} + +addl :: Int -> Pos -> Pos +addl n (Pos l c f) = Pos (l+n) c f +{-# LINE 58 "../src-derived/Desugar.hs" #-} + +{-# LINE 132 "Desugar.ag" #-} + +maybeError :: a -> Error -> Maybe a -> (a, Seq Error) +maybeError def err mb + = maybe (def, Seq.singleton err) (\r -> (r, Seq.empty)) mb + +findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier +findField fld attr list + | fld == _FIRST = f list + | fld == _LAST = f (reverse list) + | otherwise = Just fld + where + f = lookup attr +{-# LINE 73 "../src-derived/Desugar.hs" #-} + +{-# LINE 203 "Desugar.ag" #-} + +mergeAttributes :: AttrMap -> AttrMap -> AttrMap +mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union +{-# LINE 79 "../src-derived/Desugar.hs" #-} + +{-# LINE 250 "Desugar.ag" #-} + +desugarExprs :: Options -> NontermIdent -> ConstructorIdent -> + [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> + Seq Error -> [Expression] -> (Seq Error, [Expression]) +desugarExprs options nt con childInhs childSyns + = mapAccum (desugarExpr options nt con childInhs childSyns) + where mapAccum f e = foldr (\x (e0,xs) -> let (e1,x') = f e0 x in (e1, x:xs)) (e, []) + +desugarExpr :: Options -> NontermIdent -> ConstructorIdent -> + [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> + Seq Error -> Expression -> (Seq Error, Expression) +desugarExpr options nt con childInhs childSyns errs expr + = (errs Seq.>< errors_Syn_Expression syn, output_Syn_Expression syn) + where + inh = Inh_Expression { childInhs_Inh_Expression = childInhs + , childSyns_Inh_Expression = childSyns + , con_Inh_Expression = con + , nt_Inh_Expression = nt + , options_Inh_Expression = options + , ruleDescr_Inh_Expression = "augment-rule" + } + sem = sem_Expression expr + syn = wrap_Expression sem inh +{-# LINE 105 "../src-derived/Desugar.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + output : SELF + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} + visit 0: + local output : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child !(Child _name _tp _inh _syn _virtual ) = + (sem_Child_Child _name _tp _inh _syn _virtual ) +-- semantic domain +newtype T_Child = T_Child (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child )) +data Inh_Child = Inh_Child {} +data Syn_Child = Syn_Child {childInhs_Syn_Child :: !(([(Identifier, Identifier)])),childSyns_Syn_Child :: !(([(Identifier, Identifier)])),output_Syn_Child :: !(Child )} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child !(T_Child sem ) !(Inh_Child ) = + (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = sem + in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput )) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + (Maybe (Maybe Type)) -> + T_Child +sem_Child_Child !name_ !tp_ !inh_ !syn_ !virtual_ = + (T_Child (case (({-# LINE 129 "Desugar.ag" #-} + [(i, name_) | i <- Map.keys inh_ ] + {-# LINE 147 "Desugar.hs" #-} + )) of + { !_lhsOchildInhs -> + (case (({-# LINE 130 "Desugar.ag" #-} + [(s, name_) | s <- Map.keys syn_ ] + {-# LINE 152 "Desugar.hs" #-} + )) of + { !_lhsOchildSyns -> + (case (({-# LINE 39 "Desugar.ag" #-} + Child name_ tp_ inh_ syn_ virtual_ + {-# LINE 157 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 162 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) ) +-- Children ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + output : SELF + alternatives: + alternative Cons: + child hd : Child + child tl : Children + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children !list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) +-- semantic domain +newtype T_Children = T_Children (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children )) +data Inh_Children = Inh_Children {} +data Syn_Children = Syn_Children {childInhs_Syn_Children :: !(([(Identifier, Identifier)])),childSyns_Syn_Children :: !(([(Identifier, Identifier)])),output_Syn_Children :: !(Children )} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children !(T_Children sem ) !(Inh_Children ) = + (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = sem + in (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput )) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons !(T_Child hd_ ) !(T_Children tl_ ) = + (T_Children (case (tl_ ) of + { ( !_tlIchildInhs,!_tlIchildSyns,!_tlIoutput) -> + (case (hd_ ) of + { ( !_hdIchildInhs,!_hdIchildSyns,!_hdIoutput) -> + (case (({-# LINE 124 "Desugar.ag" #-} + _hdIchildInhs ++ _tlIchildInhs + {-# LINE 208 "Desugar.hs" #-} + )) of + { !_lhsOchildInhs -> + (case (({-# LINE 124 "Desugar.ag" #-} + _hdIchildSyns ++ _tlIchildSyns + {-# LINE 213 "Desugar.hs" #-} + )) of + { !_lhsOchildSyns -> + (case (({-# LINE 39 "Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 218 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 223 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) }) ) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (case (({-# LINE 124 "Desugar.ag" #-} + [] + {-# LINE 231 "Desugar.hs" #-} + )) of + { !_lhsOchildInhs -> + (case (({-# LINE 124 "Desugar.ag" #-} + [] + {-# LINE 236 "Desugar.hs" #-} + )) of + { !_lhsOchildSyns -> + (case (({-# LINE 39 "Desugar.ag" #-} + [] + {-# LINE 241 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 246 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) ) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + nt : NontermIdent + options : Options + ruleDescr : String + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local _tup1 : _ + local tks' : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression !(Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = T_Expression (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + NontermIdent -> + Options -> + String -> + ( (Seq Error),Expression )) +data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: !(([(Identifier, Identifier)])),childSyns_Inh_Expression :: !(([(Identifier, Identifier)])),con_Inh_Expression :: !(ConstructorIdent),nt_Inh_Expression :: !(NontermIdent),options_Inh_Expression :: !(Options),ruleDescr_Inh_Expression :: !(String)} +data Syn_Expression = Syn_Expression {errors_Syn_Expression :: !((Seq Error)),output_Syn_Expression :: !(Expression )} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression !(T_Expression sem ) !(Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr ) = + (let ( !_lhsOerrors,!_lhsOoutput) = sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr + in (Syn_Expression _lhsOerrors _lhsOoutput )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression !pos_ !tks_ = + (T_Expression (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIoptions) + (!_lhsIruleDescr) -> + (case (({-# LINE 48 "Desugar.ag" #-} + let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs + , childSyns_Inh_HsTokensRoot = _lhsIchildSyns + , nt_Inh_HsTokensRoot = _lhsInt + , con_Inh_HsTokensRoot = _lhsIcon + , ruleDescr_Inh_HsTokensRoot = _lhsIruleDescr + , useFieldIdent_Inh_HsTokensRoot = genUseTraces _lhsIoptions + } + sem = sem_HsTokensRoot (HsTokensRoot tks_) + syn = wrap_HsTokensRoot sem inh + in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn) + {-# LINE 313 "Desugar.hs" #-} + )) of + { !__tup1 -> + (case (({-# LINE 48 "Desugar.ag" #-} + __tup1 + {-# LINE 318 "Desugar.hs" #-} + )) of + { !(_,!_lhsOerrors) -> + (case (({-# LINE 48 "Desugar.ag" #-} + __tup1 + {-# LINE 323 "Desugar.hs" #-} + )) of + { !(!_tks',_) -> + (case (({-# LINE 58 "Desugar.ag" #-} + Expression pos_ _tks' + {-# LINE 328 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOerrors,_lhsOoutput) }) }) }) })) ) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attributes: + forcedIrrefutables : AttrMap + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) +-- semantic domain +newtype T_Grammar = T_Grammar (AttrMap -> + Options -> + ( AttrMap,(Seq Error),Grammar )) +data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: !(AttrMap),options_Inh_Grammar :: !(Options)} +data Syn_Grammar = Syn_Grammar {allAttributes_Syn_Grammar :: !(AttrMap),errors_Syn_Grammar :: !((Seq Error)),output_Syn_Grammar :: !(Grammar )} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar !(T_Grammar sem ) !(Inh_Grammar _lhsIforcedIrrefutables _lhsIoptions ) = + (let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = sem _lhsIforcedIrrefutables _lhsIoptions + in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput )) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ = + (T_Grammar (\ (!_lhsIforcedIrrefutables) + (!_lhsIoptions) -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 396 "Desugar.hs" #-} + )) of + { !_nontsOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 401 "Desugar.hs" #-} + )) of + { !_nontsOforcedIrrefutables -> + (case (({-# LINE 234 "Desugar.ag" #-} + augmentsMap_ + {-# LINE 406 "Desugar.hs" #-} + )) of + { !_nontsOaugmentsIn -> + (case (nonts_ _nontsOaugmentsIn _nontsOforcedIrrefutables _nontsOoptions ) of + { ( !_nontsIallAttributes,!_nontsIaugmentsOut,!_nontsIerrors,!_nontsIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _nontsIallAttributes + {-# LINE 413 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 37 "Desugar.ag" #-} + _nontsIerrors + {-# LINE 418 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 290 "Desugar.ag" #-} + Grammar typeSyns_ + useMap_ + derivings_ + wrappers_ + _nontsIoutput + pragmas_ + manualAttrOrderMap_ + paramMap_ + contextMap_ + quantMap_ + uniqueMap_ + _nontsIaugmentsOut + aroundsMap_ + mergeMap_ + {-# LINE 436 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) })) ) +-- HsToken ----------------------------------------------------- +{- + visit 0: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + nt : NontermIdent + ruleDescr : String + useFieldIdent : Bool + chained attribute: + addLines : Int + synthesized attributes: + errors : Seq Error + tks : SELF + alternatives: + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local mField : _ + local field' : _ + local tks : _ + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local tks : _ + alternative CharToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative Err: + child mesg : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative HsToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative StrToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken !(AGField _field _attr _pos _rdesc ) = + (sem_HsToken_AGField _field _attr _pos _rdesc ) +sem_HsToken !(AGLocal _var _pos _rdesc ) = + (sem_HsToken_AGLocal _var _pos _rdesc ) +sem_HsToken !(CharToken _value _pos ) = + (sem_HsToken_CharToken _value _pos ) +sem_HsToken !(Err _mesg _pos ) = + (sem_HsToken_Err _mesg _pos ) +sem_HsToken !(HsToken _value _pos ) = + (sem_HsToken_HsToken _value _pos ) +sem_HsToken !(StrToken _value _pos ) = + (sem_HsToken_StrToken _value _pos ) +-- semantic domain +newtype T_HsToken = T_HsToken (Int -> + ([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + NontermIdent -> + String -> + Bool -> + ( Int,(Seq Error),HsToken )) +data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: !(Int),childInhs_Inh_HsToken :: !(([(Identifier, Identifier)])),childSyns_Inh_HsToken :: !(([(Identifier, Identifier)])),con_Inh_HsToken :: !(ConstructorIdent),nt_Inh_HsToken :: !(NontermIdent),ruleDescr_Inh_HsToken :: !(String),useFieldIdent_Inh_HsToken :: !(Bool)} +data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: !(Int),errors_Syn_HsToken :: !((Seq Error)),tks_Syn_HsToken :: !(HsToken )} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken !(T_HsToken sem ) !(Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent ) = + (let ( !_lhsOaddLines,!_lhsOerrors,!_lhsOtks) = sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent + in (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks )) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField !field_ !attr_ !pos_ !rdesc_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 78 "Desugar.ag" #-} + findField field_ attr_ _lhsIchildSyns + {-# LINE 539 "Desugar.hs" #-} + )) of + { !_mField -> + (case (({-# LINE 80 "Desugar.ag" #-} + maybe field_ id _mField + {-# LINE 544 "Desugar.hs" #-} + )) of + { !_field' -> + (case (({-# LINE 83 "Desugar.ag" #-} + if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) + then _lhsIaddLines + 1 + else _lhsIaddLines + {-# LINE 551 "Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 81 "Desugar.ag" #-} + maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField + {-# LINE 556 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 87 "Desugar.ag" #-} + AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) + {-# LINE 561 "Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 69 "Desugar.ag" #-} + _tks + {-# LINE 566 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) })) ) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal !var_ !pos_ !rdesc_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 73 "Desugar.ag" #-} + if _lhsIuseFieldIdent + then _lhsIaddLines + 1 + else _lhsIaddLines + {-# LINE 586 "Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 591 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 76 "Desugar.ag" #-} + AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) + {-# LINE 596 "Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 69 "Desugar.ag" #-} + _tks + {-# LINE 601 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken !value_ !pos_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 63 "Desugar.ag" #-} + _lhsIaddLines + {-# LINE 618 "Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 623 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 91 "Desugar.ag" #-} + CharToken value_ (addl _lhsIaddLines pos_) + {-# LINE 628 "Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 69 "Desugar.ag" #-} + _tks + {-# LINE 633 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err !mesg_ !pos_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 63 "Desugar.ag" #-} + _lhsIaddLines + {-# LINE 650 "Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 655 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 95 "Desugar.ag" #-} + Err mesg_ (addl _lhsIaddLines pos_) + {-# LINE 660 "Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 69 "Desugar.ag" #-} + _tks + {-# LINE 665 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken !value_ !pos_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 63 "Desugar.ag" #-} + _lhsIaddLines + {-# LINE 682 "Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 687 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 89 "Desugar.ag" #-} + HsToken value_ (addl _lhsIaddLines pos_) + {-# LINE 692 "Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 69 "Desugar.ag" #-} + _tks + {-# LINE 697 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken !value_ !pos_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 63 "Desugar.ag" #-} + _lhsIaddLines + {-# LINE 714 "Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 719 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 93 "Desugar.ag" #-} + StrToken value_ (addl _lhsIaddLines pos_) + {-# LINE 724 "Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 69 "Desugar.ag" #-} + _tks + {-# LINE 729 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) +-- HsTokens ---------------------------------------------------- +{- + visit 0: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + nt : NontermIdent + ruleDescr : String + useFieldIdent : Bool + chained attribute: + addLines : Int + synthesized attributes: + errors : Seq Error + tks : SELF + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + visit 0: + local tks : _ + alternative Nil: + visit 0: + local tks : _ +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens !list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) ) +-- semantic domain +newtype T_HsTokens = T_HsTokens (Int -> + ([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + NontermIdent -> + String -> + Bool -> + ( Int,(Seq Error),HsTokens )) +data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: !(Int),childInhs_Inh_HsTokens :: !(([(Identifier, Identifier)])),childSyns_Inh_HsTokens :: !(([(Identifier, Identifier)])),con_Inh_HsTokens :: !(ConstructorIdent),nt_Inh_HsTokens :: !(NontermIdent),ruleDescr_Inh_HsTokens :: !(String),useFieldIdent_Inh_HsTokens :: !(Bool)} +data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: !(Int),errors_Syn_HsTokens :: !((Seq Error)),tks_Syn_HsTokens :: !(HsTokens )} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens !(T_HsTokens sem ) !(Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent ) = + (let ( !_lhsOaddLines,!_lhsOerrors,!_lhsOtks) = sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent + in (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks )) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons !(T_HsToken hd_ ) !(T_HsTokens tl_ ) = + (T_HsTokens (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 61 "Desugar.ag" #-} + _lhsIuseFieldIdent + {-# LINE 793 "Desugar.hs" #-} + )) of + { !_tlOuseFieldIdent -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 798 "Desugar.hs" #-} + )) of + { !_tlOchildSyns -> + (case (({-# LINE 61 "Desugar.ag" #-} + _lhsIuseFieldIdent + {-# LINE 803 "Desugar.hs" #-} + )) of + { !_hdOuseFieldIdent -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 808 "Desugar.hs" #-} + )) of + { !_hdOchildSyns -> + (case (({-# LINE 63 "Desugar.ag" #-} + _lhsIaddLines + {-# LINE 813 "Desugar.hs" #-} + )) of + { !_hdOaddLines -> + (case (({-# LINE 167 "Desugar.ag" #-} + _lhsIruleDescr + {-# LINE 818 "Desugar.hs" #-} + )) of + { !_hdOruleDescr -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 823 "Desugar.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 828 "Desugar.hs" #-} + )) of + { !_hdOcon -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 833 "Desugar.hs" #-} + )) of + { !_hdOchildInhs -> + (case (hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent ) of + { ( !_hdIaddLines,!_hdIerrors,!_hdItks) -> + (case (({-# LINE 63 "Desugar.ag" #-} + _hdIaddLines + {-# LINE 840 "Desugar.hs" #-} + )) of + { !_tlOaddLines -> + (case (({-# LINE 167 "Desugar.ag" #-} + _lhsIruleDescr + {-# LINE 845 "Desugar.hs" #-} + )) of + { !_tlOruleDescr -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 850 "Desugar.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 855 "Desugar.hs" #-} + )) of + { !_tlOcon -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 860 "Desugar.hs" #-} + )) of + { !_tlOchildInhs -> + (case (tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent ) of + { ( !_tlIaddLines,!_tlIerrors,!_tlItks) -> + (case (({-# LINE 63 "Desugar.ag" #-} + _tlIaddLines + {-# LINE 867 "Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 37 "Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 872 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 69 "Desugar.ag" #-} + (:) _hdItks _tlItks + {-# LINE 877 "Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 69 "Desugar.ag" #-} + _tks + {-# LINE 882 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 63 "Desugar.ag" #-} + _lhsIaddLines + {-# LINE 897 "Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 902 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 69 "Desugar.ag" #-} + [] + {-# LINE 907 "Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 69 "Desugar.ag" #-} + _tks + {-# LINE 912 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) +-- HsTokensRoot ------------------------------------------------ +{- + visit 0: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + nt : NontermIdent + ruleDescr : String + useFieldIdent : Bool + synthesized attributes: + errors : Seq Error + tks : [HsToken] + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +-- cata +sem_HsTokensRoot :: HsTokensRoot -> + T_HsTokensRoot +sem_HsTokensRoot !(HsTokensRoot _tokens ) = + (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens ) ) +-- semantic domain +newtype T_HsTokensRoot = T_HsTokensRoot (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + NontermIdent -> + String -> + Bool -> + ( (Seq Error),([HsToken]))) +data Inh_HsTokensRoot = Inh_HsTokensRoot {childInhs_Inh_HsTokensRoot :: !(([(Identifier, Identifier)])),childSyns_Inh_HsTokensRoot :: !(([(Identifier, Identifier)])),con_Inh_HsTokensRoot :: !(ConstructorIdent),nt_Inh_HsTokensRoot :: !(NontermIdent),ruleDescr_Inh_HsTokensRoot :: !(String),useFieldIdent_Inh_HsTokensRoot :: !(Bool)} +data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: !((Seq Error)),tks_Syn_HsTokensRoot :: !(([HsToken]))} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot !(T_HsTokensRoot sem ) !(Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent ) = + (let ( !_lhsOerrors,!_lhsOtks) = sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent + in (Syn_HsTokensRoot _lhsOerrors _lhsOtks )) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot !(T_HsTokens tokens_ ) = + (T_HsTokensRoot (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 965 "Desugar.hs" #-} + )) of + { !_tokensOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 970 "Desugar.hs" #-} + )) of + { !_tokensOcon -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 975 "Desugar.hs" #-} + )) of + { !_tokensOchildSyns -> + (case (({-# LINE 61 "Desugar.ag" #-} + _lhsIuseFieldIdent + {-# LINE 980 "Desugar.hs" #-} + )) of + { !_tokensOuseFieldIdent -> + (case (({-# LINE 167 "Desugar.ag" #-} + _lhsIruleDescr + {-# LINE 985 "Desugar.hs" #-} + )) of + { !_tokensOruleDescr -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 990 "Desugar.hs" #-} + )) of + { !_tokensOchildInhs -> + (case (({-# LINE 66 "Desugar.ag" #-} + 0 + {-# LINE 995 "Desugar.hs" #-} + )) of + { !_tokensOaddLines -> + (case (tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent ) of + { ( !_tokensIaddLines,!_tokensIerrors,!_tokensItks) -> + (case (({-# LINE 37 "Desugar.ag" #-} + _tokensIerrors + {-# LINE 1002 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 68 "Desugar.ag" #-} + _tokensItks + {-# LINE 1007 "Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) })) ) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + forcedIrrefutables : AttrMap + options : Options + synthesized attributes: + allAttributes : AttrMap + augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + errors : Seq Error + output : SELF + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 0: + local augmentsIn : _ + local augmentsOut : _ + local output : _ +-} +-- cata +sem_Nonterminal :: Nonterminal -> + T_Nonterminal +sem_Nonterminal !(Nonterminal _nt _params _inh _syn _prods ) = + (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) +-- semantic domain +newtype T_Nonterminal = T_Nonterminal ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + AttrMap -> + Options -> + ( AttrMap,(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))),(Seq Error),Nonterminal )) +data Inh_Nonterminal = Inh_Nonterminal {augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),forcedIrrefutables_Inh_Nonterminal :: !(AttrMap),options_Inh_Nonterminal :: !(Options)} +data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: !(AttrMap),augmentsOut_Syn_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminal :: !((Seq Error)),output_Syn_Nonterminal :: !(Nonterminal )} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions ) = + (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions + in (Syn_Nonterminal _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput )) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_ ) = + (T_Nonterminal (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIoptions) -> + (case (({-# LINE 156 "Desugar.ag" #-} + nt_ + {-# LINE 1065 "Desugar.hs" #-} + )) of + { !_prodsOnt -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 1070 "Desugar.hs" #-} + )) of + { !_prodsOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1075 "Desugar.hs" #-} + )) of + { !_prodsOforcedIrrefutables -> + (case (({-# LINE 238 "Desugar.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn + {-# LINE 1080 "Desugar.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 229 "Desugar.ag" #-} + _augmentsIn + {-# LINE 1085 "Desugar.hs" #-} + )) of + { !_prodsOaugmentsIn -> + (case (prods_ _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOnt _prodsOoptions ) of + { ( !_prodsIallAttributes,!_prodsIaugmentsOut,!_prodsIerrors,!_prodsIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _prodsIallAttributes + {-# LINE 1092 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 239 "Desugar.ag" #-} + Map.singleton nt_ _prodsIaugmentsOut + {-# LINE 1097 "Desugar.hs" #-} + )) of + { !_augmentsOut -> + (case (({-# LINE 228 "Desugar.ag" #-} + _augmentsOut + {-# LINE 1102 "Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 37 "Desugar.ag" #-} + _prodsIerrors + {-# LINE 1107 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + Nonterminal nt_ params_ inh_ syn_ _prodsIoutput + {-# LINE 1112 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 1117 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + forcedIrrefutables : AttrMap + options : Options + synthesized attributes: + allAttributes : AttrMap + augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals !list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + AttrMap -> + Options -> + ( AttrMap,(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))),(Seq Error),Nonterminals )) +data Inh_Nonterminals = Inh_Nonterminals {augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),forcedIrrefutables_Inh_Nonterminals :: !(AttrMap),options_Inh_Nonterminals :: !(Options)} +data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: !(AttrMap),augmentsOut_Syn_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminals :: !((Seq Error)),output_Syn_Nonterminals :: !(Nonterminals )} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions ) = + (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions + in (Syn_Nonterminals _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput )) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons !(T_Nonterminal hd_ ) !(T_Nonterminals tl_ ) = + (T_Nonterminals (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIoptions) -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 1170 "Desugar.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1175 "Desugar.hs" #-} + )) of + { !_tlOforcedIrrefutables -> + (case (({-# LINE 227 "Desugar.ag" #-} + _lhsIaugmentsIn + {-# LINE 1180 "Desugar.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (tl_ _tlOaugmentsIn _tlOforcedIrrefutables _tlOoptions ) of + { ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 1187 "Desugar.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1192 "Desugar.hs" #-} + )) of + { !_hdOforcedIrrefutables -> + (case (({-# LINE 227 "Desugar.ag" #-} + _lhsIaugmentsIn + {-# LINE 1197 "Desugar.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (hd_ _hdOaugmentsIn _hdOforcedIrrefutables _hdOoptions ) of + { ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# LINE 1204 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 228 "Desugar.ag" #-} + _hdIaugmentsOut `Map.union` _tlIaugmentsOut + {-# LINE 1209 "Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 37 "Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1214 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1219 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 1224 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIoptions) -> + (case (({-# LINE 195 "Desugar.ag" #-} + Map.empty + {-# LINE 1235 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 228 "Desugar.ag" #-} + Map.empty + {-# LINE 1240 "Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 1245 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + [] + {-# LINE 1250 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 1255 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) })) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + defsCollect : Set (Identifier, Identifier) + visit 1: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + defs : Set (Identifier, Identifier) + forcedIrrefutables : AttrMap + nt : NontermIdent + synthesized attributes: + allAttributes : AttrMap + copy : SELF + errors : Seq Error + output : SELF + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local def : _ + visit 1: + local copy : _ + local _tup2 : _ + local field' : _ + local err2 : _ + local err1 : _ + local output : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 1: + local copy : _ + local output : _ + alternative Irrefutable: + child pat : Pattern + visit 1: + local copy : _ + local output : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 1: + local copy : _ + local output : _ + alternative Underscore: + child pos : {Pos} + visit 1: + local copy : _ + local output : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern !(Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern !(Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern !(Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern !(Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern !(Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( (Set (Identifier, Identifier)),T_Pattern_1 )) +newtype T_Pattern_1 = T_Pattern_1 (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + (Set (Identifier, Identifier)) -> + AttrMap -> + NontermIdent -> + ( AttrMap,Pattern ,(Seq Error),Pattern )) +data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: !(([(Identifier, Identifier)])),childSyns_Inh_Pattern :: !(([(Identifier, Identifier)])),con_Inh_Pattern :: !(ConstructorIdent),defs_Inh_Pattern :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Pattern :: !(AttrMap),nt_Inh_Pattern :: !(NontermIdent)} +data Syn_Pattern = Syn_Pattern {allAttributes_Syn_Pattern :: !(AttrMap),copy_Syn_Pattern :: !(Pattern ),defsCollect_Syn_Pattern :: !((Set (Identifier, Identifier))),errors_Syn_Pattern :: !((Seq Error)),output_Syn_Pattern :: !(Pattern )} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern !(T_Pattern sem ) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt ) = + (let ( !_lhsOdefsCollect,!T_Pattern_1 sem_1) = sem + ( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) = sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt + in (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) = + (T_Pattern (case (({-# LINE 181 "Desugar.ag" #-} + Set.singleton (field_, attr_) + {-# LINE 1354 "Desugar.hs" #-} + )) of + { !_def -> + (case (parts_ ) of + { ( !_partsIdefsCollect,!T_Patterns_1 parts_1) -> + (case (pat_ ) of + { ( !_patIdefsCollect,!T_Pattern_1 pat_1) -> + (case (({-# LINE 182 "Desugar.ag" #-} + _def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect + {-# LINE 1363 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Alias_1 :: T_Pattern_1 + sem_Pattern_Alias_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 1376 "Desugar.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 1381 "Desugar.hs" #-} + )) of + { !_patOcon -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1386 "Desugar.hs" #-} + )) of + { !_patOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 1391 "Desugar.hs" #-} + )) of + { !_patOdefs -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1396 "Desugar.hs" #-} + )) of + { !_patOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1401 "Desugar.hs" #-} + )) of + { !_patOchildInhs -> + (case (pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt ) of + { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> + (case (({-# LINE 199 "Desugar.ag" #-} + (Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes + {-# LINE 1408 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 1413 "Desugar.hs" #-} + )) of + { !_partsOnt -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1418 "Desugar.hs" #-} + )) of + { !_partsOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 1423 "Desugar.hs" #-} + )) of + { !_partsOdefs -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 1428 "Desugar.hs" #-} + )) of + { !_partsOcon -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1433 "Desugar.hs" #-} + )) of + { !_partsOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1438 "Desugar.hs" #-} + )) of + { !_partsOchildInhs -> + (case (parts_1 _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt ) of + { ( !_partsIallAttributes,!_partsIcopy,!_partsIerrors,!_partsIoutput) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 1445 "Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1450 "Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 109 "Desugar.ag" #-} + maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ + findField field_ attr_ _lhsIchildInhs + {-# LINE 1456 "Desugar.hs" #-} + )) of + { !__tup2 -> + (case (({-# LINE 109 "Desugar.ag" #-} + __tup2 + {-# LINE 1461 "Desugar.hs" #-} + )) of + { !(!_field',_) -> + (case (({-# LINE 111 "Desugar.ag" #-} + if _field' == field_ + then Seq.empty + else if (_field' , attr_) `Set.member` _lhsIdefs + then Seq.singleton $ DupRule _lhsInt _lhsIcon field_ attr_ _field' + else Seq.empty + {-# LINE 1470 "Desugar.hs" #-} + )) of + { !_err2 -> + (case (({-# LINE 109 "Desugar.ag" #-} + __tup2 + {-# LINE 1475 "Desugar.hs" #-} + )) of + { !(_,!_err1) -> + (case (({-# LINE 116 "Desugar.ag" #-} + _err1 Seq.>< _err2 Seq.>< _patIerrors Seq.>< _partsIerrors + {-# LINE 1480 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 117 "Desugar.ag" #-} + Alias _field' attr_ _patIoutput _partsIoutput + {-# LINE 1485 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 218 "Desugar.ag" #-} + if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables + then Irrefutable _output + else _output + {-# LINE 1492 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Pattern_Alias_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) }) }) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_ ) = + (T_Pattern (case (pats_ ) of + { ( !_patsIdefsCollect,!T_Patterns_1 pats_1) -> + (case (({-# LINE 178 "Desugar.ag" #-} + _patsIdefsCollect + {-# LINE 1507 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Constr_1 :: T_Pattern_1 + sem_Pattern_Constr_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 1520 "Desugar.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 1525 "Desugar.hs" #-} + )) of + { !_patsOcon -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1530 "Desugar.hs" #-} + )) of + { !_patsOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 1535 "Desugar.hs" #-} + )) of + { !_patsOdefs -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1540 "Desugar.hs" #-} + )) of + { !_patsOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1545 "Desugar.hs" #-} + )) of + { !_patsOchildInhs -> + (case (pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt ) of + { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _patsIallAttributes + {-# LINE 1552 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1557 "Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1562 "Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 37 "Desugar.ag" #-} + _patsIerrors + {-# LINE 1567 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + Constr name_ _patsIoutput + {-# LINE 1572 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 1577 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Pattern_Constr_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_ ) = + (T_Pattern (case (pat_ ) of + { ( !_patIdefsCollect,!T_Pattern_1 pat_1) -> + (case (({-# LINE 178 "Desugar.ag" #-} + _patIdefsCollect + {-# LINE 1591 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Irrefutable_1 :: T_Pattern_1 + sem_Pattern_Irrefutable_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 201 "Desugar.ag" #-} + Map.empty + {-# LINE 1604 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 1609 "Desugar.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1614 "Desugar.hs" #-} + )) of + { !_patOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 1619 "Desugar.hs" #-} + )) of + { !_patOdefs -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 1624 "Desugar.hs" #-} + )) of + { !_patOcon -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1629 "Desugar.hs" #-} + )) of + { !_patOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1634 "Desugar.hs" #-} + )) of + { !_patOchildInhs -> + (case (pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt ) of + { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1641 "Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1646 "Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 37 "Desugar.ag" #-} + _patIerrors + {-# LINE 1651 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + Irrefutable _patIoutput + {-# LINE 1656 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 1661 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Pattern_Irrefutable_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_ ) = + (T_Pattern (case (pats_ ) of + { ( !_patsIdefsCollect,!T_Patterns_1 pats_1) -> + (case (({-# LINE 178 "Desugar.ag" #-} + _patsIdefsCollect + {-# LINE 1676 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Product_1 :: T_Pattern_1 + sem_Pattern_Product_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 1689 "Desugar.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 1694 "Desugar.hs" #-} + )) of + { !_patsOcon -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1699 "Desugar.hs" #-} + )) of + { !_patsOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 1704 "Desugar.hs" #-} + )) of + { !_patsOdefs -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1709 "Desugar.hs" #-} + )) of + { !_patsOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1714 "Desugar.hs" #-} + )) of + { !_patsOchildInhs -> + (case (pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt ) of + { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _patsIallAttributes + {-# LINE 1721 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1726 "Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1731 "Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 37 "Desugar.ag" #-} + _patsIerrors + {-# LINE 1736 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + Product pos_ _patsIoutput + {-# LINE 1741 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 1746 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Pattern_Product_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (case (({-# LINE 178 "Desugar.ag" #-} + Set.empty + {-# LINE 1758 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Underscore_1 :: T_Pattern_1 + sem_Pattern_Underscore_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 195 "Desugar.ag" #-} + Map.empty + {-# LINE 1771 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 1776 "Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1781 "Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 1786 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + Underscore pos_ + {-# LINE 1791 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 1796 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) })) ) + in sem_Pattern_Underscore_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + defsCollect : Set (Identifier, Identifier) + visit 1: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + defs : Set (Identifier, Identifier) + forcedIrrefutables : AttrMap + nt : NontermIdent + synthesized attributes: + allAttributes : AttrMap + copy : SELF + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 1: + local copy : _ + local output : _ + alternative Nil: + visit 1: + local copy : _ + local output : _ +-} +-- cata +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 (( (Set (Identifier, Identifier)),T_Patterns_1 )) +newtype T_Patterns_1 = T_Patterns_1 (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + (Set (Identifier, Identifier)) -> + AttrMap -> + NontermIdent -> + ( AttrMap,Patterns ,(Seq Error),Patterns )) +data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: !(([(Identifier, Identifier)])),childSyns_Inh_Patterns :: !(([(Identifier, Identifier)])),con_Inh_Patterns :: !(ConstructorIdent),defs_Inh_Patterns :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Patterns :: !(AttrMap),nt_Inh_Patterns :: !(NontermIdent)} +data Syn_Patterns = Syn_Patterns {allAttributes_Syn_Patterns :: !(AttrMap),copy_Syn_Patterns :: !(Patterns ),defsCollect_Syn_Patterns :: !((Set (Identifier, Identifier))),errors_Syn_Patterns :: !((Seq Error)),output_Syn_Patterns :: !(Patterns )} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns !(T_Patterns sem ) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt ) = + (let ( !_lhsOdefsCollect,!T_Patterns_1 sem_1) = sem + ( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) = sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt + in (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons !(T_Pattern hd_ ) !(T_Patterns tl_ ) = + (T_Patterns (case (tl_ ) of + { ( !_tlIdefsCollect,!T_Patterns_1 tl_1) -> + (case (hd_ ) of + { ( !_hdIdefsCollect,!T_Pattern_1 hd_1) -> + (case (({-# LINE 178 "Desugar.ag" #-} + _hdIdefsCollect `Set.union` _tlIdefsCollect + {-# LINE 1866 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Patterns_Cons_1 :: T_Patterns_1 + sem_Patterns_Cons_1 = + (T_Patterns_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 1879 "Desugar.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 1884 "Desugar.hs" #-} + )) of + { !_tlOcon -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 1889 "Desugar.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 1894 "Desugar.hs" #-} + )) of + { !_hdOcon -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1899 "Desugar.hs" #-} + )) of + { !_tlOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 1904 "Desugar.hs" #-} + )) of + { !_tlOdefs -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1909 "Desugar.hs" #-} + )) of + { !_tlOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1914 "Desugar.hs" #-} + )) of + { !_tlOchildInhs -> + (case (tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt ) of + { ( !_tlIallAttributes,!_tlIcopy,!_tlIerrors,!_tlIoutput) -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1921 "Desugar.hs" #-} + )) of + { !_hdOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 1926 "Desugar.hs" #-} + )) of + { !_hdOdefs -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1931 "Desugar.hs" #-} + )) of + { !_hdOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1936 "Desugar.hs" #-} + )) of + { !_hdOchildInhs -> + (case (hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt ) of + { ( !_hdIallAttributes,!_hdIcopy,!_hdIerrors,!_hdIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# LINE 1943 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1948 "Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1953 "Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 37 "Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1958 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1963 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 1968 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Patterns_Cons_1)) of + { ( !sem_Patterns_1) -> + ( _lhsOdefsCollect,sem_Patterns_1) }) }) }) }) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (case (({-# LINE 178 "Desugar.ag" #-} + Set.empty + {-# LINE 1979 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Patterns_Nil_1 :: T_Patterns_1 + sem_Patterns_Nil_1 = + (T_Patterns_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 195 "Desugar.ag" #-} + Map.empty + {-# LINE 1992 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 1997 "Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2002 "Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 2007 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + [] + {-# LINE 2012 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2017 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) })) ) + in sem_Patterns_Nil_1)) of + { ( !sem_Patterns_1) -> + ( _lhsOdefsCollect,sem_Patterns_1) }) }) ) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + forcedIrrefutables : AttrMap + nt : NontermIdent + options : Options + synthesized attributes: + allAttributes : AttrMap + augmentsOut : Map ConstructorIdent (Map Identifier [Expression]) + errors : Seq Error + output : SELF + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + visit 0: + local augmentsIn : _ + local _tup3 : _ + local augmentsOut1 : _ + local augmentsOut : _ + local augmentErrs : _ + local output : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production !(Production _con _children _rules _typeSigs ) = + (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) +-- semantic domain +newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> + AttrMap -> + NontermIdent -> + Options -> + ( AttrMap,(Map ConstructorIdent (Map Identifier [Expression])),(Seq Error),Production )) +data Inh_Production = Inh_Production {augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),forcedIrrefutables_Inh_Production :: !(AttrMap),nt_Inh_Production :: !(NontermIdent),options_Inh_Production :: !(Options)} +data Syn_Production = Syn_Production {allAttributes_Syn_Production :: !(AttrMap),augmentsOut_Syn_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),errors_Syn_Production :: !((Seq Error)),output_Syn_Production :: !(Production )} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production !(T_Production sem ) !(Inh_Production _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) = + (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions + in (Syn_Production _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput )) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production !con_ !(T_Children children_ ) !(T_Rules rules_ ) !(T_TypeSigs typeSigs_ ) = + (T_Production (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 2082 "Desugar.hs" #-} + )) of + { !_rulesOnt -> + (case (({-# LINE 160 "Desugar.ag" #-} + con_ + {-# LINE 2087 "Desugar.hs" #-} + )) of + { !_rulesOcon -> + (case (rules_ ) of + { ( !_rulesIdefsCollect,!T_Rules_1 rules_1) -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 2094 "Desugar.hs" #-} + )) of + { !_rulesOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2099 "Desugar.hs" #-} + )) of + { !_rulesOforcedIrrefutables -> + (case (children_ ) of + { ( !_childrenIchildInhs,!_childrenIchildSyns,!_childrenIoutput) -> + (case (({-# LINE 125 "Desugar.ag" #-} + _childrenIchildSyns + {-# LINE 2106 "Desugar.hs" #-} + )) of + { !_rulesOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _childrenIchildInhs + {-# LINE 2111 "Desugar.hs" #-} + )) of + { !_rulesOchildInhs -> + (case (({-# LINE 187 "Desugar.ag" #-} + _rulesIdefsCollect + {-# LINE 2116 "Desugar.hs" #-} + )) of + { !_rulesOdefs -> + (case (rules_1 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions ) of + { ( !_rulesIallAttributes,!_rulesIerrors,!_rulesIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _rulesIallAttributes + {-# LINE 2123 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 243 "Desugar.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaugmentsIn + {-# LINE 2128 "Desugar.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 246 "Desugar.ag" #-} + Map.mapAccum (desugarExprs _lhsIoptions _lhsInt con_ _childrenIchildInhs _childrenIchildSyns) Seq.empty _augmentsIn + {-# LINE 2133 "Desugar.hs" #-} + )) of + { !__tup3 -> + (case (({-# LINE 246 "Desugar.ag" #-} + __tup3 + {-# LINE 2138 "Desugar.hs" #-} + )) of + { !(_,!_augmentsOut1) -> + (case (({-# LINE 244 "Desugar.ag" #-} + Map.singleton con_ _augmentsOut1 + {-# LINE 2143 "Desugar.hs" #-} + )) of + { !_augmentsOut -> + (case (({-# LINE 230 "Desugar.ag" #-} + _augmentsOut + {-# LINE 2148 "Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 246 "Desugar.ag" #-} + __tup3 + {-# LINE 2153 "Desugar.hs" #-} + )) of + { !(!_augmentErrs,_) -> + (case (({-# LINE 282 "Desugar.ag" #-} + _rulesIerrors Seq.>< _augmentErrs + {-# LINE 2158 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (typeSigs_ ) of + { ( !_typeSigsIoutput) -> + (case (({-# LINE 39 "Desugar.ag" #-} + Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput + {-# LINE 2165 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2170 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + forcedIrrefutables : AttrMap + nt : NontermIdent + options : Options + synthesized attributes: + allAttributes : AttrMap + augmentsOut : Map ConstructorIdent (Map Identifier [Expression]) + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions !list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) +-- semantic domain +newtype T_Productions = T_Productions ((Map ConstructorIdent (Map Identifier [Expression])) -> + AttrMap -> + NontermIdent -> + Options -> + ( AttrMap,(Map ConstructorIdent (Map Identifier [Expression])),(Seq Error),Productions )) +data Inh_Productions = Inh_Productions {augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),forcedIrrefutables_Inh_Productions :: !(AttrMap),nt_Inh_Productions :: !(NontermIdent),options_Inh_Productions :: !(Options)} +data Syn_Productions = Syn_Productions {allAttributes_Syn_Productions :: !(AttrMap),augmentsOut_Syn_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),errors_Syn_Productions :: !((Seq Error)),output_Syn_Productions :: !(Productions )} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions !(T_Productions sem ) !(Inh_Productions _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) = + (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions + in (Syn_Productions _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput )) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons !(T_Production hd_ ) !(T_Productions tl_ ) = + (T_Productions (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 2226 "Desugar.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 2231 "Desugar.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 2236 "Desugar.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2241 "Desugar.hs" #-} + )) of + { !_tlOforcedIrrefutables -> + (case (({-# LINE 229 "Desugar.ag" #-} + _lhsIaugmentsIn + {-# LINE 2246 "Desugar.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (tl_ _tlOaugmentsIn _tlOforcedIrrefutables _tlOnt _tlOoptions ) of + { ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 2253 "Desugar.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2258 "Desugar.hs" #-} + )) of + { !_hdOforcedIrrefutables -> + (case (({-# LINE 229 "Desugar.ag" #-} + _lhsIaugmentsIn + {-# LINE 2263 "Desugar.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (hd_ _hdOaugmentsIn _hdOforcedIrrefutables _hdOnt _hdOoptions ) of + { ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# LINE 2270 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 230 "Desugar.ag" #-} + _hdIaugmentsOut `Map.union` _tlIaugmentsOut + {-# LINE 2275 "Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 37 "Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2280 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2285 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2290 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 195 "Desugar.ag" #-} + Map.empty + {-# LINE 2302 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 230 "Desugar.ag" #-} + Map.empty + {-# LINE 2307 "Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 2312 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + [] + {-# LINE 2317 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2322 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) })) ) +-- Rule -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + defsCollect : Set (Identifier, Identifier) + visit 1: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + defs : Set (Identifier, Identifier) + forcedIrrefutables : AttrMap + nt : NontermIdent + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + visit 1: + local ruleDescr : _ + local output : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit ) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) +-- semantic domain +newtype T_Rule = T_Rule (( (Set (Identifier, Identifier)),T_Rule_1 )) +newtype T_Rule_1 = T_Rule_1 (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + (Set (Identifier, Identifier)) -> + AttrMap -> + NontermIdent -> + Options -> + ( AttrMap,(Seq Error),Rule )) +data Inh_Rule = Inh_Rule {childInhs_Inh_Rule :: !(([(Identifier, Identifier)])),childSyns_Inh_Rule :: !(([(Identifier, Identifier)])),con_Inh_Rule :: !(ConstructorIdent),defs_Inh_Rule :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Rule :: !(AttrMap),nt_Inh_Rule :: !(NontermIdent),options_Inh_Rule :: !(Options)} +data Syn_Rule = Syn_Rule {allAttributes_Syn_Rule :: !(AttrMap),defsCollect_Syn_Rule :: !((Set (Identifier, Identifier))),errors_Syn_Rule :: !((Seq Error)),output_Syn_Rule :: !(Rule )} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule !(T_Rule sem ) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) = + (let ( !_lhsOdefsCollect,!T_Rule_1 sem_1) = sem + ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions + in (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput )) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + T_Rule +sem_Rule_Rule !mbName_ !(T_Pattern pattern_ ) !(T_Expression rhs_ ) !owrt_ !origin_ !explicit_ = + (T_Rule (case (pattern_ ) of + { ( !_patternIdefsCollect,!T_Pattern_1 pattern_1) -> + (case (({-# LINE 178 "Desugar.ag" #-} + _patternIdefsCollect + {-# LINE 2392 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Rule_Rule_1 :: T_Rule_1 + sem_Rule_Rule_1 = + (T_Rule_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 2406 "Desugar.hs" #-} + )) of + { !_patternOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 2411 "Desugar.hs" #-} + )) of + { !_patternOcon -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2416 "Desugar.hs" #-} + )) of + { !_patternOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 2421 "Desugar.hs" #-} + )) of + { !_patternOdefs -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2426 "Desugar.hs" #-} + )) of + { !_patternOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2431 "Desugar.hs" #-} + )) of + { !_patternOchildInhs -> + (case (pattern_1 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt ) of + { ( !_patternIallAttributes,!_patternIcopy,!_patternIerrors,!_patternIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _patternIallAttributes + {-# LINE 2438 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 171 "Desugar.ag" #-} + show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect) + {-# LINE 2443 "Desugar.hs" #-} + )) of + { !_ruleDescr -> + (case (({-# LINE 167 "Desugar.ag" #-} + _ruleDescr + {-# LINE 2448 "Desugar.hs" #-} + )) of + { !_rhsOruleDescr -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 2453 "Desugar.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 2458 "Desugar.hs" #-} + )) of + { !_rhsOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 2463 "Desugar.hs" #-} + )) of + { !_rhsOcon -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2468 "Desugar.hs" #-} + )) of + { !_rhsOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2473 "Desugar.hs" #-} + )) of + { !_rhsOchildInhs -> + (case (rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr ) of + { ( !_rhsIerrors,!_rhsIoutput) -> + (case (({-# LINE 37 "Desugar.ag" #-} + _patternIerrors Seq.>< _rhsIerrors + {-# LINE 2480 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ + {-# LINE 2485 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2490 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Rule_Rule_1)) of + { ( !sem_Rule_1) -> + ( _lhsOdefsCollect,sem_Rule_1) }) }) }) ) +-- Rules ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + defsCollect : Set (Identifier, Identifier) + visit 1: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + defs : Set (Identifier, Identifier) + forcedIrrefutables : AttrMap + nt : NontermIdent + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + visit 1: + local output : _ + alternative Nil: + visit 1: + local output : _ +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules !list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) +-- semantic domain +newtype T_Rules = T_Rules (( (Set (Identifier, Identifier)),T_Rules_1 )) +newtype T_Rules_1 = T_Rules_1 (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + (Set (Identifier, Identifier)) -> + AttrMap -> + NontermIdent -> + Options -> + ( AttrMap,(Seq Error),Rules )) +data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: !(([(Identifier, Identifier)])),childSyns_Inh_Rules :: !(([(Identifier, Identifier)])),con_Inh_Rules :: !(ConstructorIdent),defs_Inh_Rules :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Rules :: !(AttrMap),nt_Inh_Rules :: !(NontermIdent),options_Inh_Rules :: !(Options)} +data Syn_Rules = Syn_Rules {allAttributes_Syn_Rules :: !(AttrMap),defsCollect_Syn_Rules :: !((Set (Identifier, Identifier))),errors_Syn_Rules :: !((Seq Error)),output_Syn_Rules :: !(Rules )} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules !(T_Rules sem ) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) = + (let ( !_lhsOdefsCollect,!T_Rules_1 sem_1) = sem + ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions + in (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput )) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons !(T_Rule hd_ ) !(T_Rules tl_ ) = + (T_Rules (case (tl_ ) of + { ( !_tlIdefsCollect,!T_Rules_1 tl_1) -> + (case (hd_ ) of + { ( !_hdIdefsCollect,!T_Rule_1 hd_1) -> + (case (({-# LINE 178 "Desugar.ag" #-} + _hdIdefsCollect `Set.union` _tlIdefsCollect + {-# LINE 2559 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Rules_Cons_1 :: T_Rules_1 + sem_Rules_Cons_1 = + (T_Rules_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 2573 "Desugar.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 2578 "Desugar.hs" #-} + )) of + { !_tlOcon -> + (case (({-# LINE 151 "Desugar.ag" #-} + _lhsInt + {-# LINE 2583 "Desugar.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 152 "Desugar.ag" #-} + _lhsIcon + {-# LINE 2588 "Desugar.hs" #-} + )) of + { !_hdOcon -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 2593 "Desugar.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2598 "Desugar.hs" #-} + )) of + { !_tlOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 2603 "Desugar.hs" #-} + )) of + { !_tlOdefs -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2608 "Desugar.hs" #-} + )) of + { !_tlOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2613 "Desugar.hs" #-} + )) of + { !_tlOchildInhs -> + (case (tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions ) of + { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> + (case (({-# LINE 35 "Desugar.ag" #-} + _lhsIoptions + {-# LINE 2620 "Desugar.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 214 "Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2625 "Desugar.hs" #-} + )) of + { !_hdOforcedIrrefutables -> + (case (({-# LINE 184 "Desugar.ag" #-} + _lhsIdefs + {-# LINE 2630 "Desugar.hs" #-} + )) of + { !_hdOdefs -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2635 "Desugar.hs" #-} + )) of + { !_hdOchildSyns -> + (case (({-# LINE 125 "Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2640 "Desugar.hs" #-} + )) of + { !_hdOchildInhs -> + (case (hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions ) of + { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> + (case (({-# LINE 195 "Desugar.ag" #-} + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# LINE 2647 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 37 "Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2652 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2657 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2662 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Rules_Cons_1)) of + { ( !sem_Rules_1) -> + ( _lhsOdefsCollect,sem_Rules_1) }) }) }) }) ) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (case (({-# LINE 178 "Desugar.ag" #-} + Set.empty + {-# LINE 2673 "Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Rules_Nil_1 :: T_Rules_1 + sem_Rules_Nil_1 = + (T_Rules_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 195 "Desugar.ag" #-} + Map.empty + {-# LINE 2687 "Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 37 "Desugar.ag" #-} + Seq.empty + {-# LINE 2692 "Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 39 "Desugar.ag" #-} + [] + {-# LINE 2697 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2702 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) })) ) + in sem_Rules_Nil_1)) of + { ( !sem_Rules_1) -> + ( _lhsOdefsCollect,sem_Rules_1) }) }) ) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : SELF + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} + visit 0: + local output : _ +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig !(TypeSig _name _tp ) = + (sem_TypeSig_TypeSig _name _tp ) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( TypeSig )) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig )} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig !(T_TypeSig sem ) !(Inh_TypeSig ) = + (let ( !_lhsOoutput) = sem + in (Syn_TypeSig _lhsOoutput )) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig !name_ !tp_ = + (T_TypeSig (case (({-# LINE 39 "Desugar.ag" #-} + TypeSig name_ tp_ + {-# LINE 2742 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2747 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) ) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : SELF + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs !list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( TypeSigs )) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs )} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs !(T_TypeSigs sem ) !(Inh_TypeSigs ) = + (let ( !_lhsOoutput) = sem + in (Syn_TypeSigs _lhsOoutput )) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons !(T_TypeSig hd_ ) !(T_TypeSigs tl_ ) = + (T_TypeSigs (case (tl_ ) of + { ( !_tlIoutput) -> + (case (hd_ ) of + { ( !_hdIoutput) -> + (case (({-# LINE 39 "Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2791 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2796 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) }) ) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (case (({-# LINE 39 "Desugar.ag" #-} + [] + {-# LINE 2804 "Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 39 "Desugar.ag" #-} + _output + {-# LINE 2809 "Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) ) diff --git a/src-derived/ErrorMessages.hs b/src-derived/ErrorMessages.hs new file mode 100644 --- /dev/null +++ b/src-derived/ErrorMessages.hs @@ -0,0 +1,181 @@ + + +-- UUAGC 0.9.38.1 (ErrorMessages.ag) +module ErrorMessages where +{-# LINE 2 "ErrorMessages.ag" #-} + +import UU.Scanner.Position(Pos) +import Pretty +import DepTypes(Trace) +import CodeSyntax +import CommonTypes +{-# LINE 13 "../src-derived/ErrorMessages.hs" #-} +-- Error ------------------------------------------------------- +{- + alternatives: + alternative ChildAsLocal: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child var : {Identifier} + alternative CustomError: + child isWarning : {Bool} + child pos : {Pos} + child mesg : {PP_Doc} + alternative CyclicSet: + child name : {Identifier} + alternative DirectCirc: + child nt : {NontermIdent} + child o_visit : {Bool} + child cyclic : {[((Identifier,Identifier),[String],[String])]} + alternative DupAlt: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child occ1 : {ConstructorIdent} + alternative DupChild: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child name : {Identifier} + child occ1 : {Identifier} + alternative DupInhAttr: + child nt : {NontermIdent} + child attr : {Identifier} + child occ1 : {Identifier} + alternative DupRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + child occ1 : {Identifier} + alternative DupRuleName: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child nm : {Identifier} + alternative DupSet: + child name : {NontermIdent} + child occ1 : {NontermIdent} + alternative DupSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + alternative DupSynAttr: + child nt : {NontermIdent} + child attr : {Identifier} + child occ1 : {Identifier} + alternative DupSynonym: + child nt : {NontermIdent} + child occ1 : {NontermIdent} + alternative DupUnique: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + alternative HsParseError: + child pos : {Pos} + child msg : {String} + alternative InducedCirc: + child nt : {NontermIdent} + child cinter : {CInterface} + child cyclic : {[((Identifier,Identifier),[String],[String])]} + alternative InstCirc: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + child o_visit : {Bool} + child path : {[String]} + alternative LocalCirc: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + child o_visit : {Bool} + child path : {[String]} + alternative MissingInstSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + alternative MissingNamedRule: + child nt : {NontermIdent} + child con : {Identifier} + child name : {Identifier} + alternative MissingRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + alternative MissingSyn: + child nt : {NontermIdent} + child attr : {Identifier} + alternative MissingTypeSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + alternative MissingUnique: + child nt : {NontermIdent} + child attr : {Identifier} + alternative ParserError: + child pos : {Pos} + child problem : {String} + child action : {String} + alternative SuperfluousRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + alternative UndefAlt: + child nt : {NontermIdent} + child con : {ConstructorIdent} + alternative UndefAttr: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + child isOut : {Bool} + alternative UndefChild: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child name : {Identifier} + alternative UndefLocal: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child var : {Identifier} + alternative UndefNont: + child nt : {NontermIdent} +-} +data Error = ChildAsLocal (NontermIdent) (ConstructorIdent) (Identifier) + | CustomError (Bool) (Pos) (PP_Doc) + | CyclicSet (Identifier) + | DirectCirc (NontermIdent) (Bool) (([((Identifier,Identifier),[String],[String])])) + | DupAlt (NontermIdent) (ConstructorIdent) (ConstructorIdent) + | DupChild (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) + | DupInhAttr (NontermIdent) (Identifier) (Identifier) + | DupRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Identifier) + | DupRuleName (NontermIdent) (ConstructorIdent) (Identifier) + | DupSet (NontermIdent) (NontermIdent) + | DupSig (NontermIdent) (ConstructorIdent) (Identifier) + | DupSynAttr (NontermIdent) (Identifier) (Identifier) + | DupSynonym (NontermIdent) (NontermIdent) + | DupUnique (NontermIdent) (ConstructorIdent) (Identifier) + | HsParseError (Pos) (String) + | InducedCirc (NontermIdent) (CInterface) (([((Identifier,Identifier),[String],[String])])) + | InstCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) (([String])) + | LocalCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) (([String])) + | MissingInstSig (NontermIdent) (ConstructorIdent) (Identifier) + | MissingNamedRule (NontermIdent) (Identifier) (Identifier) + | MissingRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) + | MissingSyn (NontermIdent) (Identifier) + | MissingTypeSig (NontermIdent) (ConstructorIdent) (Identifier) + | MissingUnique (NontermIdent) (Identifier) + | ParserError (Pos) (String) (String) + | SuperfluousRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) + | UndefAlt (NontermIdent) (ConstructorIdent) + | UndefAttr (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Bool) + | UndefChild (NontermIdent) (ConstructorIdent) (Identifier) + | UndefLocal (NontermIdent) (ConstructorIdent) (Identifier) + | UndefNont (NontermIdent) +-- Errors ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Error + child tl : Errors + alternative Nil: +-} +type Errors = [Error ] diff --git a/src-derived/ExecutionPlan.hs b/src-derived/ExecutionPlan.hs new file mode 100644 --- /dev/null +++ b/src-derived/ExecutionPlan.hs @@ -0,0 +1,148 @@ + + +-- UUAGC 0.9.38.2 (ExecutionPlan.ag) +module ExecutionPlan where +{-# LINE 2 "ExecutionPlan.ag" #-} + +-- VisitSyntax.ag imports +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes + +import qualified Data.Set as Set +{-# LINE 14 "../src-derived/ExecutionPlan.hs" #-} +-- EChild ------------------------------------------------------ +{- + alternatives: + alternative EChild: + child name : {Identifier} + child tp : {Type} + child virtual : {Maybe (Maybe Type)} +-} +data EChild = EChild (Identifier) (Type) ((Maybe (Maybe Type))) +-- EChildren --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : EChild + child tl : EChildren + alternative Nil: +-} +type EChildren = [EChild ] +-- ENonterminal ------------------------------------------------ +{- + alternatives: + alternative ENonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child initial : {StateIdentifier} + child initialv : {Maybe VisitIdentifier} + child prods : EProductions +-} +data ENonterminal = ENonterminal (NontermIdent) (([Identifier])) (StateIdentifier) ((Maybe VisitIdentifier)) (EProductions ) +-- ENonterminals ----------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : ENonterminal + child tl : ENonterminals + alternative Nil: +-} +type ENonterminals = [ENonterminal ] +-- EProduction ------------------------------------------------- +{- + alternatives: + alternative EProduction: + child con : {ConstructorIdent} + child rules : ERules + child children : EChildren + child visits : Visits +-} +data EProduction = EProduction (ConstructorIdent) (ERules ) (EChildren ) (Visits ) +-- EProductions ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : EProduction + child tl : EProductions + alternative Nil: +-} +type EProductions = [EProduction ] +-- ERule ------------------------------------------------------- +{- + alternatives: + alternative ERule: + child name : {Identifier} + child pattern : {Pattern} + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} +-} +data ERule = ERule (Identifier) (Pattern) (Expression) (Bool) (String) (Bool) +-- ERules ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : ERule + child tl : ERules + alternative Nil: +-} +type ERules = [ERule ] +-- ExecutionPlan ----------------------------------------------- +{- + alternatives: + alternative ExecutionPlan: + child nonts : ENonterminals + child typeSyns : {TypeSyns} + child wrappers : {Set.Set NontermIdent} +-} +data ExecutionPlan = ExecutionPlan (ENonterminals ) (TypeSyns) ((Set.Set NontermIdent)) +-- Visit ------------------------------------------------------- +{- + alternatives: + alternative Visit: + child ident : {VisitIdentifier} + child from : {StateIdentifier} + child to : {StateIdentifier} + child inh : {Set.Set Identifier} + child syn : {Set.Set Identifier} + child steps : VisitSteps +-} +data Visit = Visit (VisitIdentifier) (StateIdentifier) (StateIdentifier) ((Set.Set Identifier)) ((Set.Set Identifier)) (VisitSteps ) +-- VisitStep --------------------------------------------------- +{- + alternatives: + alternative ChildIntro: + child child : {Identifier} + alternative ChildVisit: + child child : {Identifier} + child nonterm : {NontermIdent} + child visit : {VisitIdentifier} + alternative Sem: + child name : {Identifier} + alternative Sim: + child steps : VisitSteps +-} +data VisitStep = ChildIntro (Identifier) + | ChildVisit (Identifier) (NontermIdent) (VisitIdentifier) + | Sem (Identifier) + | Sim (VisitSteps ) +-- VisitSteps -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisitStep + child tl : VisitSteps + alternative Nil: +-} +type VisitSteps = [VisitStep ] +-- Visits ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Visit + child tl : Visits + alternative Nil: +-} +type Visits = [Visit ] diff --git a/src-derived/ExecutionPlan2Hs.hs b/src-derived/ExecutionPlan2Hs.hs new file mode 100644 --- /dev/null +++ b/src-derived/ExecutionPlan2Hs.hs @@ -0,0 +1,3717 @@ + + +-- UUAGC 0.9.38.2 (ExecutionPlan2Hs.ag) +module ExecutionPlan2Hs where +{-# LINE 7 "ExecutionPlan2Hs.ag" #-} + +import ExecutionPlan +import Pretty +import PPUtil +import Options +import Data.Maybe +import Debug.Trace + +import TokenDef +import HsToken + +import qualified Data.Set as Set +import qualified Data.Map as Map +{-# LINE 20 "../src-derived/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./ExecutionPlan.ag" #-} + +-- VisitSyntax.ag imports +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes + +import qualified Data.Set as Set +{-# LINE 30 "../src-derived/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 37 "../src-derived/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 43 "../src-derived/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 49 "../src-derived/ExecutionPlan2Hs.hs" #-} +{-# LINE 393 "ExecutionPlan2Hs.ag" #-} + +uwSetUnion :: (Ord a, Ord b) => Map.Map a (Set.Set b) -> Map.Map a (Set.Set b) -> Map.Map a (Set.Set b) +uwSetUnion = Map.unionWith Set.union +{-# LINE 54 "../src-derived/ExecutionPlan2Hs.hs" #-} +-- EChild ------------------------------------------------------ +{- + visit 0: + inherited attribute: + nt : NontermIdent + synthesized attributes: + argnames : PP_Doc + argnamesw : PP_Doc + argtps : PP_Doc + childintros : Map.Map Identifier PP_Doc + datatype : PP_Doc + terminaldefs : Set.Set String + alternatives: + alternative EChild: + child name : {Identifier} + child tp : {Type} + child virtual : {Maybe (Maybe Type)} + visit 0: + local argnames : _ +-} +-- cata +sem_EChild :: EChild -> + T_EChild +sem_EChild (EChild _name _tp _virtual ) = + (sem_EChild_EChild _name _tp _virtual ) +-- semantic domain +newtype T_EChild = T_EChild (NontermIdent -> + ( ( PP_Doc ),( PP_Doc ),( PP_Doc ),(Map.Map Identifier PP_Doc),PP_Doc,(Set.Set String))) +data Inh_EChild = Inh_EChild {nt_Inh_EChild :: NontermIdent} +data Syn_EChild = Syn_EChild {argnames_Syn_EChild :: ( PP_Doc ),argnamesw_Syn_EChild :: ( PP_Doc ),argtps_Syn_EChild :: ( PP_Doc ),childintros_Syn_EChild :: (Map.Map Identifier PP_Doc),datatype_Syn_EChild :: PP_Doc,terminaldefs_Syn_EChild :: (Set.Set String)} +wrap_EChild :: T_EChild -> + Inh_EChild -> + Syn_EChild +wrap_EChild (T_EChild sem ) (Inh_EChild _lhsInt ) = + (let ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsInt + in (Syn_EChild _lhsOargnames _lhsOargnamesw _lhsOargtps _lhsOchildintros _lhsOdatatype _lhsOterminaldefs )) +sem_EChild_EChild :: Identifier -> + Type -> + (Maybe (Maybe Type)) -> + T_EChild +sem_EChild_EChild name_ tp_ virtual_ = + (T_EChild (\ _lhsInt -> + (let _lhsOdatatype :: PP_Doc + _lhsOargnamesw :: ( PP_Doc ) + _lhsOargtps :: ( PP_Doc ) + _lhsOchildintros :: (Map.Map Identifier PP_Doc) + _lhsOterminaldefs :: (Set.Set String) + _lhsOargnames :: ( PP_Doc ) + -- "ExecutionPlan2Hs.ag"(line 90, column 12) + _lhsOdatatype = + ({-# LINE 90 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ + then empty + else pp $ typeToHaskellString (Just _lhsInt) [] tp_ + {-# LINE 109 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 112, column 12) + _lhsOargnamesw = + ({-# LINE 112 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ + then empty + else if isNonterminal tp_ + then "(" >#< "sem_" >|< extractNonterminal tp_ >#< "field_" >|< name_ >#< ")" + else text $ locname name_ + {-# LINE 119 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 256, column 12) + _lhsOargtps = + ({-# LINE 256 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ + then empty + else if isNonterminal tp_ + then ("T_" >|< extractNonterminal tp_) >#< "->" + else (text $ show tp_) >#< "->" + {-# LINE 129 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 261, column 12) + _argnames = + ({-# LINE 261 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ + then empty + else if isNonterminal tp_ + then "field_" >|< name_ + else text $ locname name_ + {-# LINE 139 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 327, column 12) + _lhsOchildintros = + ({-# LINE 327 "ExecutionPlan2Hs.ag" #-} + Map.singleton name_ $ locname name_ >#< "<-" >#< "return" >#< "$" >#< + if isJust virtual_ + then "sem_" >|< extractNonterminal tp_ >#< instname name_ + else "field_" >|< name_ + {-# LINE 148 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 404, column 12) + _lhsOterminaldefs = + ({-# LINE 404 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ || isNonterminal tp_ + then Set.empty + else Set.singleton $ locname name_ + {-# LINE 156 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _lhsOargnames = + ({-# LINE 251 "ExecutionPlan2Hs.ag" #-} + _argnames + {-# LINE 162 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) +-- EChildren --------------------------------------------------- +{- + visit 0: + inherited attribute: + nt : NontermIdent + synthesized attributes: + argnames : [PP_Doc] + argnamesw : [PP_Doc] + argtps : [PP_Doc] + childintros : Map.Map Identifier PP_Doc + datatype : [PP_Doc] + terminaldefs : Set.Set String + alternatives: + alternative Cons: + child hd : EChild + child tl : EChildren + alternative Nil: +-} +-- cata +sem_EChildren :: EChildren -> + T_EChildren +sem_EChildren list = + (Prelude.foldr sem_EChildren_Cons sem_EChildren_Nil (Prelude.map sem_EChild list) ) +-- semantic domain +newtype T_EChildren = T_EChildren (NontermIdent -> + ( ( [PP_Doc] ),([PP_Doc]),( [PP_Doc] ),(Map.Map Identifier PP_Doc),([PP_Doc]),(Set.Set String))) +data Inh_EChildren = Inh_EChildren {nt_Inh_EChildren :: NontermIdent} +data Syn_EChildren = Syn_EChildren {argnames_Syn_EChildren :: ( [PP_Doc] ),argnamesw_Syn_EChildren :: ([PP_Doc]),argtps_Syn_EChildren :: ( [PP_Doc] ),childintros_Syn_EChildren :: (Map.Map Identifier PP_Doc),datatype_Syn_EChildren :: ([PP_Doc]),terminaldefs_Syn_EChildren :: (Set.Set String)} +wrap_EChildren :: T_EChildren -> + Inh_EChildren -> + Syn_EChildren +wrap_EChildren (T_EChildren sem ) (Inh_EChildren _lhsInt ) = + (let ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsInt + in (Syn_EChildren _lhsOargnames _lhsOargnamesw _lhsOargtps _lhsOchildintros _lhsOdatatype _lhsOterminaldefs )) +sem_EChildren_Cons :: T_EChild -> + T_EChildren -> + T_EChildren +sem_EChildren_Cons (T_EChild hd_ ) (T_EChildren tl_ ) = + (T_EChildren (\ _lhsInt -> + (let _lhsOargnames :: ( [PP_Doc] ) + _lhsOargnamesw :: ([PP_Doc]) + _lhsOargtps :: ( [PP_Doc] ) + _lhsOchildintros :: (Map.Map Identifier PP_Doc) + _lhsOdatatype :: ([PP_Doc]) + _lhsOterminaldefs :: (Set.Set String) + _hdOnt :: NontermIdent + _tlOnt :: NontermIdent + _hdIargnames :: ( PP_Doc ) + _hdIargnamesw :: ( PP_Doc ) + _hdIargtps :: ( PP_Doc ) + _hdIchildintros :: (Map.Map Identifier PP_Doc) + _hdIdatatype :: PP_Doc + _hdIterminaldefs :: (Set.Set String) + _tlIargnames :: ( [PP_Doc] ) + _tlIargnamesw :: ([PP_Doc]) + _tlIargtps :: ( [PP_Doc] ) + _tlIchildintros :: (Map.Map Identifier PP_Doc) + _tlIdatatype :: ([PP_Doc]) + _tlIterminaldefs :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 253, column 31) + _lhsOargnames = + ({-# LINE 253 "ExecutionPlan2Hs.ag" #-} + _hdIargnames : _tlIargnames + {-# LINE 228 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 109, column 32) + _lhsOargnamesw = + ({-# LINE 109 "ExecutionPlan2Hs.ag" #-} + _hdIargnamesw : _tlIargnamesw + {-# LINE 234 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 252, column 31) + _lhsOargtps = + ({-# LINE 252 "ExecutionPlan2Hs.ag" #-} + _hdIargtps : _tlIargtps + {-# LINE 240 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 318, column 41) + _lhsOchildintros = + ({-# LINE 318 "ExecutionPlan2Hs.ag" #-} + _hdIchildintros `Map.union` _tlIchildintros + {-# LINE 246 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 87, column 51) + _lhsOdatatype = + ({-# LINE 87 "ExecutionPlan2Hs.ag" #-} + _hdIdatatype : _tlIdatatype + {-# LINE 252 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 401, column 42) + _lhsOterminaldefs = + ({-# LINE 401 "ExecutionPlan2Hs.ag" #-} + _hdIterminaldefs `Set.union` _tlIterminaldefs + {-# LINE 258 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 86 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 264 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 87 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 270 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIargnames,_hdIargnamesw,_hdIargtps,_hdIchildintros,_hdIdatatype,_hdIterminaldefs) = + hd_ _hdOnt + ( _tlIargnames,_tlIargnamesw,_tlIargtps,_tlIchildintros,_tlIdatatype,_tlIterminaldefs) = + tl_ _tlOnt + in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) +sem_EChildren_Nil :: T_EChildren +sem_EChildren_Nil = + (T_EChildren (\ _lhsInt -> + (let _lhsOargnames :: ( [PP_Doc] ) + _lhsOargnamesw :: ([PP_Doc]) + _lhsOargtps :: ( [PP_Doc] ) + _lhsOchildintros :: (Map.Map Identifier PP_Doc) + _lhsOdatatype :: ([PP_Doc]) + _lhsOterminaldefs :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 253, column 31) + _lhsOargnames = + ({-# LINE 253 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 290 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 109, column 32) + _lhsOargnamesw = + ({-# LINE 109 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 296 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 252, column 31) + _lhsOargtps = + ({-# LINE 252 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 302 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 318, column 41) + _lhsOchildintros = + ({-# LINE 318 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 308 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 87, column 51) + _lhsOdatatype = + ({-# LINE 87 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 314 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 401, column 42) + _lhsOterminaldefs = + ({-# LINE 401 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 320 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) +-- ENonterminal ------------------------------------------------ +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + inhmap : Map.Map NontermIdent Attributes + options : Options + synmap : Map.Map NontermIdent Attributes + typeSyns : TypeSyns + wrappers : Set.Set NontermIdent + synthesized attributes: + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + debugoutput : PP_Doc + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative ENonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child initial : {StateIdentifier} + child initialv : {Maybe VisitIdentifier} + child prods : EProductions + visit 0: + local datatype : _ + local sem_nt : _ + local outedges : _ + local inedges : _ + local allstates : _ + local t_init : _ + local t_states : _ + local k_states : _ + local wr_inh : _ + local wr_syn : _ + local genwrap : _ + local wr_inhs : _ + local wr_syns : _ + local inhlist : _ + local synlist : _ + local wrapper : _ +-} +-- cata +sem_ENonterminal :: ENonterminal -> + T_ENonterminal +sem_ENonterminal (ENonterminal _nt _params _initial _initialv _prods ) = + (sem_ENonterminal_ENonterminal _nt _params _initial _initialv (sem_EProductions _prods ) ) +-- semantic domain +newtype T_ENonterminal = T_ENonterminal ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map NontermIdent Attributes) -> + Options -> + (Map.Map NontermIdent Attributes) -> + TypeSyns -> + (Set.Set NontermIdent) -> + ( (Map.Map VisitIdentifier (Identifier -> PP_Doc)),PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_ENonterminal = Inh_ENonterminal {allchildvisit_Inh_ENonterminal :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),inhmap_Inh_ENonterminal :: (Map.Map NontermIdent Attributes),options_Inh_ENonterminal :: Options,synmap_Inh_ENonterminal :: (Map.Map NontermIdent Attributes),typeSyns_Inh_ENonterminal :: TypeSyns,wrappers_Inh_ENonterminal :: (Set.Set NontermIdent)} +data Syn_ENonterminal = Syn_ENonterminal {childvisit_Syn_ENonterminal :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),debugoutput_Syn_ENonterminal :: PP_Doc,visitdefs_Syn_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_ENonterminal :: T_ENonterminal -> + Inh_ENonterminal -> + Syn_ENonterminal +wrap_ENonterminal (T_ENonterminal sem ) (Inh_ENonterminal _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers ) = + (let ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers + in (Syn_ENonterminal _lhsOchildvisit _lhsOdebugoutput _lhsOvisitdefs _lhsOvisituses )) +sem_ENonterminal_ENonterminal :: NontermIdent -> + ([Identifier]) -> + StateIdentifier -> + (Maybe VisitIdentifier) -> + T_EProductions -> + T_ENonterminal +sem_ENonterminal_ENonterminal nt_ params_ initial_ initialv_ (T_EProductions prods_ ) = + (T_ENonterminal (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _prodsOrename :: Bool + _lhsOdebugoutput :: PP_Doc + _prodsOinhmap :: Attributes + _prodsOsynmap :: Attributes + _prodsOnt :: NontermIdent + _prodsOinitial :: StateIdentifier + _prodsOallstates :: (Set.Set StateIdentifier) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _prodsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _prodsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _prodsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _prodsIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _prodsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _prodsIdatatype :: ([PP_Doc]) + _prodsIsem_nt :: PP_Doc + _prodsIsem_prod :: PP_Doc + _prodsIt_visits :: PP_Doc + _prodsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _prodsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 34, column 18) + _prodsOrename = + ({-# LINE 34 "ExecutionPlan2Hs.ag" #-} + rename _lhsIoptions + {-# LINE 428 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 54, column 18) + _lhsOdebugoutput = + ({-# LINE 54 "ExecutionPlan2Hs.ag" #-} + (if dataTypes _lhsIoptions then _datatype else empty) + >-< (if nt_ `Set.member` _lhsIwrappers + then _wr_inh + >-< _wr_syn + >-< _wrapper + else empty) + >-< _sem_nt + >-< _t_init + >-< _t_states + >-< _k_states + >-< _prodsIt_visits + >-< _prodsIsem_prod + {-# LINE 445 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 74, column 18) + _datatype = + ({-# LINE 74 "ExecutionPlan2Hs.ag" #-} + case lookup nt_ _lhsItypeSyns of + Nothing -> "data" >#< nt_ >#< (vlist $ ("=" >#< head _prodsIdatatype) + : (map ("|" >#<) $ tail _prodsIdatatype)) + Just (List t) -> "type" >#< nt_ >#< "=" >#< "[" >#< show t >#< "]" + Just x -> error $ "Type " ++ show x ++ " is not supported yet" + {-# LINE 455 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 96, column 18) + _sem_nt = + ({-# LINE 96 "ExecutionPlan2Hs.ag" #-} + "sem_" >|< nt_ >#< "::" >#< nt_ >#< "->" >#< "T_" >|< nt_ + >-< case lookup nt_ _lhsItypeSyns of + Nothing -> _prodsIsem_nt + Just (List t) -> "sem_" >|< nt_ >#< "list" >#< "=" >#< "Prelude.foldr sem_" + >|< nt_ >|< "_Cons" >#< "sem_" >|< nt_ >|< "_Nil" + >#< "(" >#< "Prelude.map sem_" >|< show t >#< "list" >#< ")" + {-# LINE 466 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 132, column 19) + (Just _prodsOinhmap ) = + ({-# LINE 132 "ExecutionPlan2Hs.ag" #-} + Map.lookup nt_ _lhsIinhmap + {-# LINE 472 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 133, column 19) + (Just _prodsOsynmap ) = + ({-# LINE 133 "ExecutionPlan2Hs.ag" #-} + Map.lookup nt_ _lhsIsynmap + {-# LINE 478 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 149, column 18) + _outedges = + ({-# LINE 149 "ExecutionPlan2Hs.ag" #-} + Set.fromList $ map (\(_,f,_) -> f) _prodsIallvisits + {-# LINE 484 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 150, column 18) + _inedges = + ({-# LINE 150 "ExecutionPlan2Hs.ag" #-} + Set.fromList $ map (\(_,_,t) -> t) _prodsIallvisits + {-# LINE 490 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 151, column 18) + _allstates = + ({-# LINE 151 "ExecutionPlan2Hs.ag" #-} + Set.insert initial_ $ _inedges `Set.union` _outedges + {-# LINE 496 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 152, column 18) + _t_init = + ({-# LINE 152 "ExecutionPlan2Hs.ag" #-} + "type" >#< "T_" >|< nt_ >#< "=" >#< "T_" >|< nt_ >|< "_s" >|< initial_ + {-# LINE 502 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 153, column 18) + _t_states = + ({-# LINE 153 "ExecutionPlan2Hs.ag" #-} + vlist $ map (\st -> + let nt_st = nt_ >|< "_s" >|< st + t_st = "T_" >|< nt_st + k_st = "K_" >|< nt_st + c_st = "C_" >|< nt_st + inv_st = "inv_" >|< nt_st + in "data" >#< t_st >#< "where" >#< c_st >#< "::" >#< "{" >#< inv_st >#< "::" + >#< "forall t." >#< k_st >#< "t" >#< "->" >#< "t" >#< "}" + >#< "->" >#< t_st + ) $ Set.toList _allstates + {-# LINE 517 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 166, column 18) + _k_states = + ({-# LINE 166 "ExecutionPlan2Hs.ag" #-} + vlist $ map (\st -> + let nt_st = nt_ >|< "_s" >|< st + k_st = "K_" >|< nt_st + outg = filter (\(v,f,t) -> f == st) _prodsIallvisits + visitlist = vlist $ map (\(v,f,t) -> + "K_" >|< nt_ >|< "_v" >|< v >#< "::" >#< k_st >#< "T_" >|< nt_ >|< "_v" >|< v + ) outg + in "data" >#< k_st >#< "k" >#< "where" + >-< indent 3 visitlist) $ Set.toList _allstates + {-# LINE 531 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 194, column 18) + _prodsOnt = + ({-# LINE 194 "ExecutionPlan2Hs.ag" #-} + nt_ + {-# LINE 537 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 210, column 18) + _wr_inh = + ({-# LINE 210 "ExecutionPlan2Hs.ag" #-} + _genwrap "Inh" _wr_inhs + {-# LINE 543 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 211, column 18) + _wr_syn = + ({-# LINE 211 "ExecutionPlan2Hs.ag" #-} + _genwrap "Syn" _wr_syns + {-# LINE 549 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 212, column 18) + _genwrap = + ({-# LINE 212 "ExecutionPlan2Hs.ag" #-} + \nm attr -> "data" >#< nm >|< "_" >|< nt_ >#< "=" >#< nm >|< "_" >|< nt_ >#< "{" + >#< (ppCommas $ map (\(i,t) -> i >|< "_" >|< nm >|< "_" >|< nt_ >#< "::" + >#< typeToHaskellString (Just nt_) [] t) attr) >#< "}" + {-# LINE 557 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 215, column 18) + _wr_inhs = + ({-# LINE 215 "ExecutionPlan2Hs.ag" #-} + Map.toList $ fromJust $ Map.lookup nt_ _lhsIinhmap + {-# LINE 563 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 216, column 18) + _wr_syns = + ({-# LINE 216 "ExecutionPlan2Hs.ag" #-} + Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap + {-# LINE 569 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 217, column 18) + _inhlist = + ({-# LINE 217 "ExecutionPlan2Hs.ag" #-} + map (lhsname True . fst) _wr_inhs + {-# LINE 575 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 218, column 18) + _synlist = + ({-# LINE 218 "ExecutionPlan2Hs.ag" #-} + map (lhsname False . fst) _wr_syns + {-# LINE 581 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 219, column 18) + _wrapper = + ({-# LINE 219 "ExecutionPlan2Hs.ag" #-} + ("wrap_" >|< nt_ >#< "::" >#< "T_" >|< nt_ >#< "->" + >#< "Inh_" >|< nt_ >#< "->" >#< "Syn_" >|< nt_) + >-< + (("wrap_" >|< nt_ >#< "sem" >#< "(" >#< "Inh_" >|< nt_ + >#< ppSpaced _inhlist >#< ")" >#< "=") + >-< + indent 3 ("let" >#< "(" >#< ppCommas _synlist >#< "," >#< "_" >#< ")" >#< "=" + >#< "runIdentity" >#< "$" >#< "(" >#< "inv_" >|< nt_ >|< "_s" >|< initial_ + >#< "sem" >#< "K_" >|< nt_ >|< "_v" >|< fromJust initialv_ >#< ")" + >#< ppSpaced _inhlist + >-< + "in " >#< "(" >#< "Syn_" >|< nt_ >#< ppSpaced _synlist >#< ")") + ) + {-# LINE 599 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 247, column 33) + _prodsOinitial = + ({-# LINE 247 "ExecutionPlan2Hs.ag" #-} + initial_ + {-# LINE 605 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 248, column 33) + _prodsOallstates = + ({-# LINE 248 "ExecutionPlan2Hs.ag" #-} + _allstates + {-# LINE 611 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _prodsIchildvisit + {-# LINE 617 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _prodsIvisitdefs + {-# LINE 623 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _prodsIvisituses + {-# LINE 629 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 635 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 641 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 647 "ExecutionPlan2Hs.hs" #-} + ) + ( _prodsIallvisits,_prodsIchildvisit,_prodsIdatatype,_prodsIsem_nt,_prodsIsem_prod,_prodsIt_visits,_prodsIvisitdefs,_prodsIvisituses) = + prods_ _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOinhmap _prodsOinitial _prodsOnt _prodsOrename _prodsOsynmap + in ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses))) ) +-- ENonterminals ----------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + inhmap : Map.Map NontermIdent Attributes + options : Options + synmap : Map.Map NontermIdent Attributes + typeSyns : TypeSyns + wrappers : Set.Set NontermIdent + synthesized attributes: + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + debugoutput : PP_Doc + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative Cons: + child hd : ENonterminal + child tl : ENonterminals + alternative Nil: +-} +-- cata +sem_ENonterminals :: ENonterminals -> + T_ENonterminals +sem_ENonterminals list = + (Prelude.foldr sem_ENonterminals_Cons sem_ENonterminals_Nil (Prelude.map sem_ENonterminal list) ) +-- semantic domain +newtype T_ENonterminals = T_ENonterminals ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map NontermIdent Attributes) -> + Options -> + (Map.Map NontermIdent Attributes) -> + TypeSyns -> + (Set.Set NontermIdent) -> + ( (Map.Map VisitIdentifier (Identifier -> PP_Doc)),PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_ENonterminals = Inh_ENonterminals {allchildvisit_Inh_ENonterminals :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),inhmap_Inh_ENonterminals :: (Map.Map NontermIdent Attributes),options_Inh_ENonterminals :: Options,synmap_Inh_ENonterminals :: (Map.Map NontermIdent Attributes),typeSyns_Inh_ENonterminals :: TypeSyns,wrappers_Inh_ENonterminals :: (Set.Set NontermIdent)} +data Syn_ENonterminals = Syn_ENonterminals {childvisit_Syn_ENonterminals :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),debugoutput_Syn_ENonterminals :: PP_Doc,visitdefs_Syn_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_ENonterminals :: T_ENonterminals -> + Inh_ENonterminals -> + Syn_ENonterminals +wrap_ENonterminals (T_ENonterminals sem ) (Inh_ENonterminals _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers ) = + (let ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers + in (Syn_ENonterminals _lhsOchildvisit _lhsOdebugoutput _lhsOvisitdefs _lhsOvisituses )) +sem_ENonterminals_Cons :: T_ENonterminal -> + T_ENonterminals -> + T_ENonterminals +sem_ENonterminals_Cons (T_ENonterminal hd_ ) (T_ENonterminals tl_ ) = + (T_ENonterminals (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOdebugoutput :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOinhmap :: (Map.Map NontermIdent Attributes) + _hdOoptions :: Options + _hdOsynmap :: (Map.Map NontermIdent Attributes) + _hdOtypeSyns :: TypeSyns + _hdOwrappers :: (Set.Set NontermIdent) + _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOinhmap :: (Map.Map NontermIdent Attributes) + _tlOoptions :: Options + _tlOsynmap :: (Map.Map NontermIdent Attributes) + _tlOtypeSyns :: TypeSyns + _tlOwrappers :: (Set.Set NontermIdent) + _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdIdebugoutput :: PP_Doc + _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlIdebugoutput :: PP_Doc + _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 742 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 48, column 85) + _lhsOdebugoutput = + ({-# LINE 48 "ExecutionPlan2Hs.ag" #-} + _hdIdebugoutput >-< _tlIdebugoutput + {-# LINE 748 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 754 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 760 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 766 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 772 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 778 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 122 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 784 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 30 "ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 790 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 123 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 796 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOtypeSyns = + ({-# LINE 68 "ExecutionPlan2Hs.ag" #-} + _lhsItypeSyns + {-# LINE 802 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOwrappers = + ({-# LINE 48 "ExecutionPlan2Hs.ag" #-} + _lhsIwrappers + {-# LINE 808 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 814 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 820 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 826 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 122 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 832 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 30 "ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 838 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 123 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 844 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOtypeSyns = + ({-# LINE 68 "ExecutionPlan2Hs.ag" #-} + _lhsItypeSyns + {-# LINE 850 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOwrappers = + ({-# LINE 48 "ExecutionPlan2Hs.ag" #-} + _lhsIwrappers + {-# LINE 856 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIchildvisit,_hdIdebugoutput,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOinhmap _hdOoptions _hdOsynmap _hdOtypeSyns _hdOwrappers + ( _tlIchildvisit,_tlIdebugoutput,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOinhmap _tlOoptions _tlOsynmap _tlOtypeSyns _tlOwrappers + in ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses))) ) +sem_ENonterminals_Nil :: T_ENonterminals +sem_ENonterminals_Nil = + (T_ENonterminals (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOdebugoutput :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 881 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 48, column 85) + _lhsOdebugoutput = + ({-# LINE 48 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 887 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 893 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 899 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses))) ) +-- EProduction ------------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + allstates : Set.Set StateIdentifier + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + inhmap : Attributes + initial : StateIdentifier + nt : NontermIdent + rename : Bool + synmap : Attributes + synthesized attributes: + allvisits : [(VisitIdentifier,StateIdentifier, StateIdentifier)] + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + datatype : PP_Doc + sem_nt : PP_Doc + sem_prod : PP_Doc + t_visits : PP_Doc + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative EProduction: + child con : {ConstructorIdent} + child rules : ERules + child children : EChildren + child visits : Visits + visit 0: + local args : _ + local statefns : _ + local stargs : _ + local stks : _ + local stvisits : _ + local stvs : _ +-} +-- cata +sem_EProduction :: EProduction -> + T_EProduction +sem_EProduction (EProduction _con _rules _children _visits ) = + (sem_EProduction_EProduction _con (sem_ERules _rules ) (sem_EChildren _children ) (sem_Visits _visits ) ) +-- semantic domain +newtype T_EProduction = T_EProduction ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Set.Set StateIdentifier) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + Attributes -> + StateIdentifier -> + NontermIdent -> + Bool -> + Attributes -> + ( ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),PP_Doc,PP_Doc,PP_Doc,PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_EProduction = Inh_EProduction {allchildvisit_Inh_EProduction :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allstates_Inh_EProduction :: (Set.Set StateIdentifier),avisitdefs_Inh_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),inhmap_Inh_EProduction :: Attributes,initial_Inh_EProduction :: StateIdentifier,nt_Inh_EProduction :: NontermIdent,rename_Inh_EProduction :: Bool,synmap_Inh_EProduction :: Attributes} +data Syn_EProduction = Syn_EProduction {allvisits_Syn_EProduction :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),childvisit_Syn_EProduction :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),datatype_Syn_EProduction :: PP_Doc,sem_nt_Syn_EProduction :: PP_Doc,sem_prod_Syn_EProduction :: PP_Doc,t_visits_Syn_EProduction :: PP_Doc,visitdefs_Syn_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_EProduction :: T_EProduction -> + Inh_EProduction -> + Syn_EProduction +wrap_EProduction (T_EProduction sem ) (Inh_EProduction _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsInt _lhsIrename _lhsIsynmap ) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsInt _lhsIrename _lhsIsynmap + in (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOdatatype _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitdefs _lhsOvisituses )) +sem_EProduction_EProduction :: ConstructorIdent -> + T_ERules -> + T_EChildren -> + T_Visits -> + T_EProduction +sem_EProduction_EProduction con_ (T_ERules rules_ ) (T_EChildren children_ ) (T_Visits visits_ ) = + (T_EProduction (\ _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsInt + _lhsIrename + _lhsIsynmap -> + (let _lhsOdatatype :: PP_Doc + _lhsOsem_nt :: PP_Doc + _rulesOusedrules :: (Set.Set Identifier) + _lhsOsem_prod :: PP_Doc + _visitsOmrules :: (Map.Map Identifier PP_Doc) + _visitsOchildintros :: (Map.Map Identifier PP_Doc) + _visitsOallintramap :: (Map.Map StateIdentifier (Set.Set String)) + _visitsOterminaldefs :: (Set.Set String) + _visitsOruledefs :: (Map.Map Identifier (Set.Set String)) + _visitsOruleuses :: (Map.Map Identifier (Set.Set String)) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOt_visits :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _childrenOnt :: NontermIdent + _visitsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _visitsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _visitsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _visitsOinhmap :: Attributes + _visitsOnt :: NontermIdent + _visitsOsynmap :: Attributes + _rulesImrules :: (Map.Map Identifier PP_Doc) + _rulesIruledefs :: (Map.Map Identifier (Set.Set String)) + _rulesIruleuses :: (Map.Map Identifier (Set.Set String)) + _rulesIsem_rules :: PP_Doc + _childrenIargnames :: ( [PP_Doc] ) + _childrenIargnamesw :: ([PP_Doc]) + _childrenIargtps :: ( [PP_Doc] ) + _childrenIchildintros :: (Map.Map Identifier PP_Doc) + _childrenIdatatype :: ([PP_Doc]) + _childrenIterminaldefs :: (Set.Set String) + _visitsIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _visitsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _visitsIintramap :: (Map.Map StateIdentifier (Set.Set String)) + _visitsIsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _visitsIt_visits :: PP_Doc + _visitsIusedrules :: (Set.Set Identifier) + _visitsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _visitsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 84, column 17) + _lhsOdatatype = + ({-# LINE 84 "ExecutionPlan2Hs.ag" #-} + conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIdatatype + {-# LINE 1021 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 105, column 17) + _lhsOsem_nt = + ({-# LINE 105 "ExecutionPlan2Hs.ag" #-} + "sem_" >|< _lhsInt >#< "(" >#< conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIargnames >#< ")" + >#< "=" >#< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw + {-# LINE 1028 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 182, column 17) + _rulesOusedrules = + ({-# LINE 182 "ExecutionPlan2Hs.ag" #-} + _visitsIusedrules + {-# LINE 1034 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 268, column 17) + _args = + ({-# LINE 268 "ExecutionPlan2Hs.ag" #-} + _childrenIargnames + {-# LINE 1040 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 269, column 17) + _lhsOsem_prod = + ({-# LINE 269 "ExecutionPlan2Hs.ag" #-} + "sem_" >|< _lhsInt >|< "_" >|< con_ >#< "::" >#< ppSpaced _childrenIargtps >#< "T_" >|< _lhsInt + >-< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _args >#< "=" + >#< "st" >|< _lhsIinitial >#< "where" + >-< (indent 3 $ vlist _statefns >-< _rulesIsem_rules) + {-# LINE 1049 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 273, column 17) + _statefns = + ({-# LINE 273 "ExecutionPlan2Hs.ag" #-} + map (\st -> "st" >|< st >#< _stargs st >#< "=" >#< + "C_" >|< _lhsInt >|< "_s" >|< st >#< "k" >|< st >#< "where" + >-< indent 3 (_stks st >-< _stvs st) + ) $ Set.toList _lhsIallstates + {-# LINE 1058 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 277, column 17) + _stargs = + ({-# LINE 277 "ExecutionPlan2Hs.ag" #-} + \st -> ppSpaced $ Set.toList $ maybe Set.empty id $ Map.lookup st _visitsIintramap + {-# LINE 1064 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 278, column 17) + _stks = + ({-# LINE 278 "ExecutionPlan2Hs.ag" #-} + \st -> "k" >|< st >#< "::" >#< "K_" >|< _lhsInt >|< "_s" >|< st >#< "t" >#< "->" >#< "t" + >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< _lhsInt >|< "_v" >|< v >#< "=" + >#< "v" >|< v) $ _stvisits st) + >-< if null (_stvisits st) + then "k" >|< st >#< "_" >#< "=" >#< "error \"unreachable\"" + else empty + {-# LINE 1075 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 284, column 17) + _stvisits = + ({-# LINE 284 "ExecutionPlan2Hs.ag" #-} + \st -> filter (\(v,f,t) -> f == st) _visitsIallvisits + {-# LINE 1081 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 285, column 17) + _stvs = + ({-# LINE 285 "ExecutionPlan2Hs.ag" #-} + \st -> vlist $ map snd $ filter (\(f,pp) -> f == st) _visitsIsem_visit + {-# LINE 1087 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 286, column 17) + _visitsOmrules = + ({-# LINE 286 "ExecutionPlan2Hs.ag" #-} + _rulesImrules + {-# LINE 1093 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 324, column 17) + _visitsOchildintros = + ({-# LINE 324 "ExecutionPlan2Hs.ag" #-} + _childrenIchildintros + {-# LINE 1099 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 409, column 17) + _visitsOallintramap = + ({-# LINE 409 "ExecutionPlan2Hs.ag" #-} + _visitsIintramap + {-# LINE 1105 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 410, column 17) + _visitsOterminaldefs = + ({-# LINE 410 "ExecutionPlan2Hs.ag" #-} + _childrenIterminaldefs + {-# LINE 1111 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 429, column 17) + _visitsOruledefs = + ({-# LINE 429 "ExecutionPlan2Hs.ag" #-} + _rulesIruledefs + {-# LINE 1117 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 430, column 17) + _visitsOruleuses = + ({-# LINE 430 "ExecutionPlan2Hs.ag" #-} + _rulesIruleuses + {-# LINE 1123 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _visitsIchildvisit + {-# LINE 1129 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 188, column 54) + _lhsOt_visits = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _visitsIt_visits + {-# LINE 1135 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _visitsIvisitdefs + {-# LINE 1141 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _visitsIvisituses + {-# LINE 1147 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOallvisits = + ({-# LINE 138 "ExecutionPlan2Hs.ag" #-} + _visitsIallvisits + {-# LINE 1153 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOnt = + ({-# LINE 87 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 1159 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 1165 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 1171 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 1177 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1183 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 1189 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1195 "ExecutionPlan2Hs.hs" #-} + ) + ( _rulesImrules,_rulesIruledefs,_rulesIruleuses,_rulesIsem_rules) = + rules_ _rulesOusedrules + ( _childrenIargnames,_childrenIargnamesw,_childrenIargtps,_childrenIchildintros,_childrenIdatatype,_childrenIterminaldefs) = + children_ _childrenOnt + ( _visitsIallvisits,_visitsIchildvisit,_visitsIintramap,_visitsIsem_visit,_visitsIt_visits,_visitsIusedrules,_visitsIvisitdefs,_visitsIvisituses) = + visits_ _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildintros _visitsOinhmap _visitsOmrules _visitsOnt _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) +-- EProductions ------------------------------------------------ +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + allstates : Set.Set StateIdentifier + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + inhmap : Attributes + initial : StateIdentifier + nt : NontermIdent + rename : Bool + synmap : Attributes + synthesized attributes: + allvisits : [(VisitIdentifier,StateIdentifier, StateIdentifier)] + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + datatype : [PP_Doc] + sem_nt : PP_Doc + sem_prod : PP_Doc + t_visits : PP_Doc + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative Cons: + child hd : EProduction + child tl : EProductions + alternative Nil: +-} +-- cata +sem_EProductions :: EProductions -> + T_EProductions +sem_EProductions list = + (Prelude.foldr sem_EProductions_Cons sem_EProductions_Nil (Prelude.map sem_EProduction list) ) +-- semantic domain +newtype T_EProductions = T_EProductions ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Set.Set StateIdentifier) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + Attributes -> + StateIdentifier -> + NontermIdent -> + Bool -> + Attributes -> + ( ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),([PP_Doc]),PP_Doc,PP_Doc,PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_EProductions = Inh_EProductions {allchildvisit_Inh_EProductions :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allstates_Inh_EProductions :: (Set.Set StateIdentifier),avisitdefs_Inh_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),inhmap_Inh_EProductions :: Attributes,initial_Inh_EProductions :: StateIdentifier,nt_Inh_EProductions :: NontermIdent,rename_Inh_EProductions :: Bool,synmap_Inh_EProductions :: Attributes} +data Syn_EProductions = Syn_EProductions {allvisits_Syn_EProductions :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),childvisit_Syn_EProductions :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),datatype_Syn_EProductions :: ([PP_Doc]),sem_nt_Syn_EProductions :: PP_Doc,sem_prod_Syn_EProductions :: PP_Doc,t_visits_Syn_EProductions :: PP_Doc,visitdefs_Syn_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_EProductions :: T_EProductions -> + Inh_EProductions -> + Syn_EProductions +wrap_EProductions (T_EProductions sem ) (Inh_EProductions _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsInt _lhsIrename _lhsIsynmap ) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsInt _lhsIrename _lhsIsynmap + in (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOdatatype _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitdefs _lhsOvisituses )) +sem_EProductions_Cons :: T_EProduction -> + T_EProductions -> + T_EProductions +sem_EProductions_Cons (T_EProduction hd_ ) (T_EProductions tl_ ) = + (T_EProductions (\ _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsInt + _lhsIrename + _lhsIsynmap -> + (let _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _lhsOt_visits :: PP_Doc + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOdatatype :: ([PP_Doc]) + _lhsOsem_nt :: PP_Doc + _lhsOsem_prod :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdOallstates :: (Set.Set StateIdentifier) + _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOinhmap :: Attributes + _hdOinitial :: StateIdentifier + _hdOnt :: NontermIdent + _hdOrename :: Bool + _hdOsynmap :: Attributes + _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlOallstates :: (Set.Set StateIdentifier) + _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOinhmap :: Attributes + _tlOinitial :: StateIdentifier + _tlOnt :: NontermIdent + _tlOrename :: Bool + _tlOsynmap :: Attributes + _hdIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdIdatatype :: PP_Doc + _hdIsem_nt :: PP_Doc + _hdIsem_prod :: PP_Doc + _hdIt_visits :: PP_Doc + _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlIdatatype :: ([PP_Doc]) + _tlIsem_nt :: PP_Doc + _tlIsem_prod :: PP_Doc + _tlIt_visits :: PP_Doc + _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 144, column 10) + _lhsOallvisits = + ({-# LINE 144 "ExecutionPlan2Hs.ag" #-} + _hdIallvisits + {-# LINE 1315 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 191, column 10) + _lhsOt_visits = + ({-# LINE 191 "ExecutionPlan2Hs.ag" #-} + _hdIt_visits + {-# LINE 1321 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 1327 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 81, column 34) + _lhsOdatatype = + ({-# LINE 81 "ExecutionPlan2Hs.ag" #-} + _hdIdatatype : _tlIdatatype + {-# LINE 1333 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 103, column 44) + _lhsOsem_nt = + ({-# LINE 103 "ExecutionPlan2Hs.ag" #-} + _hdIsem_nt >-< _tlIsem_nt + {-# LINE 1339 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 244, column 34) + _lhsOsem_prod = + ({-# LINE 244 "ExecutionPlan2Hs.ag" #-} + _hdIsem_prod >-< _tlIsem_prod + {-# LINE 1345 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 1351 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 1357 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 1363 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallstates = + ({-# LINE 246 "ExecutionPlan2Hs.ag" #-} + _lhsIallstates + {-# LINE 1369 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 1375 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 1381 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1387 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinitial = + ({-# LINE 246 "ExecutionPlan2Hs.ag" #-} + _lhsIinitial + {-# LINE 1393 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 1399 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOrename = + ({-# LINE 31 "ExecutionPlan2Hs.ag" #-} + _lhsIrename + {-# LINE 1405 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1411 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 1417 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallstates = + ({-# LINE 246 "ExecutionPlan2Hs.ag" #-} + _lhsIallstates + {-# LINE 1423 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 1429 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 1435 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1441 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinitial = + ({-# LINE 246 "ExecutionPlan2Hs.ag" #-} + _lhsIinitial + {-# LINE 1447 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 1453 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOrename = + ({-# LINE 31 "ExecutionPlan2Hs.ag" #-} + _lhsIrename + {-# LINE 1459 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1465 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIallvisits,_hdIchildvisit,_hdIdatatype,_hdIsem_nt,_hdIsem_prod,_hdIt_visits,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOinhmap _hdOinitial _hdOnt _hdOrename _hdOsynmap + ( _tlIallvisits,_tlIchildvisit,_tlIdatatype,_tlIsem_nt,_tlIsem_prod,_tlIt_visits,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOinhmap _tlOinitial _tlOnt _tlOrename _tlOsynmap + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) +sem_EProductions_Nil :: T_EProductions +sem_EProductions_Nil = + (T_EProductions (\ _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsInt + _lhsIrename + _lhsIsynmap -> + (let _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOdatatype :: ([PP_Doc]) + _lhsOsem_nt :: PP_Doc + _lhsOsem_prod :: PP_Doc + _lhsOt_visits :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 145, column 10) + _lhsOallvisits = + ({-# LINE 145 "ExecutionPlan2Hs.ag" #-} + error "Every nonterminal should have at least 1 production" + {-# LINE 1495 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1501 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 81, column 34) + _lhsOdatatype = + ({-# LINE 81 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 1507 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 103, column 44) + _lhsOsem_nt = + ({-# LINE 103 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 1513 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 244, column 34) + _lhsOsem_prod = + ({-# LINE 244 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 1519 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 188, column 54) + _lhsOt_visits = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 1525 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1531 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1537 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) +-- ERule ------------------------------------------------------- +{- + visit 0: + inherited attribute: + usedrules : Set.Set Identifier + synthesized attributes: + mrules : Map.Map Identifier PP_Doc + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + sem_rules : PP_Doc + alternatives: + alternative ERule: + child name : {Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + visit 0: + local attrlst : _ +-} +-- cata +sem_ERule :: ERule -> + T_ERule +sem_ERule (ERule _name _pattern _rhs _owrt _origin _explicit ) = + (sem_ERule_ERule _name (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) +-- semantic domain +newtype T_ERule = T_ERule ((Set.Set Identifier) -> + ( (Map.Map Identifier PP_Doc),(Map.Map Identifier (Set.Set String)),(Map.Map Identifier (Set.Set String)),PP_Doc)) +data Inh_ERule = Inh_ERule {usedrules_Inh_ERule :: (Set.Set Identifier)} +data Syn_ERule = Syn_ERule {mrules_Syn_ERule :: (Map.Map Identifier PP_Doc),ruledefs_Syn_ERule :: (Map.Map Identifier (Set.Set String)),ruleuses_Syn_ERule :: (Map.Map Identifier (Set.Set String)),sem_rules_Syn_ERule :: PP_Doc} +wrap_ERule :: T_ERule -> + Inh_ERule -> + Syn_ERule +wrap_ERule (T_ERule sem ) (Inh_ERule _lhsIusedrules ) = + (let ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIusedrules + in (Syn_ERule _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules )) +sem_ERule_ERule :: Identifier -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + T_ERule +sem_ERule_ERule name_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = + (T_ERule (\ _lhsIusedrules -> + (let _lhsOsem_rules :: PP_Doc + _lhsOmrules :: (Map.Map Identifier PP_Doc) + _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) + _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) + _patternIattrs :: (Set.Set String) + _patternIcopy :: Pattern + _patternIsem_lhs :: PP_Doc + _rhsIattrs :: (Set.Set String) + _rhsIsemfunc :: PP_Doc + -- "ExecutionPlan2Hs.ag"(line 337, column 11) + _lhsOsem_rules = + ({-# LINE 337 "ExecutionPlan2Hs.ag" #-} + if Set.member name_ _lhsIusedrules + then (name_ >#< "=" >#< + (if Set.null _rhsIattrs + then empty + else "\\" >|< _attrlst >#< "->") + >#< _rhsIsemfunc) + else empty + {-# LINE 1605 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 344, column 11) + _attrlst = + ({-# LINE 344 "ExecutionPlan2Hs.ag" #-} + ppSpaced $ Set.toList _rhsIattrs + {-# LINE 1611 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 345, column 11) + _lhsOmrules = + ({-# LINE 345 "ExecutionPlan2Hs.ag" #-} + Map.singleton name_ $ _patternIsem_lhs >#< "<-" >#< "return" >#< "$" >#< name_ >#< _attrlst + {-# LINE 1617 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 425, column 11) + _lhsOruledefs = + ({-# LINE 425 "ExecutionPlan2Hs.ag" #-} + Map.singleton name_ _patternIattrs + {-# LINE 1623 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 426, column 11) + _lhsOruleuses = + ({-# LINE 426 "ExecutionPlan2Hs.ag" #-} + Map.singleton name_ _rhsIattrs + {-# LINE 1629 "ExecutionPlan2Hs.hs" #-} + ) + ( _patternIattrs,_patternIcopy,_patternIsem_lhs) = + pattern_ + ( _rhsIattrs,_rhsIsemfunc) = + rhs_ + in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) +-- ERules ------------------------------------------------------ +{- + visit 0: + inherited attribute: + usedrules : Set.Set Identifier + synthesized attributes: + mrules : Map.Map Identifier PP_Doc + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + sem_rules : PP_Doc + alternatives: + alternative Cons: + child hd : ERule + child tl : ERules + alternative Nil: +-} +-- cata +sem_ERules :: ERules -> + T_ERules +sem_ERules list = + (Prelude.foldr sem_ERules_Cons sem_ERules_Nil (Prelude.map sem_ERule list) ) +-- semantic domain +newtype T_ERules = T_ERules ((Set.Set Identifier) -> + ( (Map.Map Identifier PP_Doc),(Map.Map Identifier (Set.Set String)),(Map.Map Identifier (Set.Set String)),PP_Doc)) +data Inh_ERules = Inh_ERules {usedrules_Inh_ERules :: (Set.Set Identifier)} +data Syn_ERules = Syn_ERules {mrules_Syn_ERules :: (Map.Map Identifier PP_Doc),ruledefs_Syn_ERules :: (Map.Map Identifier (Set.Set String)),ruleuses_Syn_ERules :: (Map.Map Identifier (Set.Set String)),sem_rules_Syn_ERules :: PP_Doc} +wrap_ERules :: T_ERules -> + Inh_ERules -> + Syn_ERules +wrap_ERules (T_ERules sem ) (Inh_ERules _lhsIusedrules ) = + (let ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIusedrules + in (Syn_ERules _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules )) +sem_ERules_Cons :: T_ERule -> + T_ERules -> + T_ERules +sem_ERules_Cons (T_ERule hd_ ) (T_ERules tl_ ) = + (T_ERules (\ _lhsIusedrules -> + (let _lhsOmrules :: (Map.Map Identifier PP_Doc) + _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) + _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) + _lhsOsem_rules :: PP_Doc + _hdOusedrules :: (Set.Set Identifier) + _tlOusedrules :: (Set.Set Identifier) + _hdImrules :: (Map.Map Identifier PP_Doc) + _hdIruledefs :: (Map.Map Identifier (Set.Set String)) + _hdIruleuses :: (Map.Map Identifier (Set.Set String)) + _hdIsem_rules :: PP_Doc + _tlImrules :: (Map.Map Identifier PP_Doc) + _tlIruledefs :: (Map.Map Identifier (Set.Set String)) + _tlIruleuses :: (Map.Map Identifier (Set.Set String)) + _tlIsem_rules :: PP_Doc + -- use rule "ExecutionPlan2Hs.ag"(line 334, column 32) + _lhsOmrules = + ({-# LINE 334 "ExecutionPlan2Hs.ag" #-} + _hdImrules `Map.union` _tlImrules + {-# LINE 1691 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 418, column 34) + _lhsOruledefs = + ({-# LINE 418 "ExecutionPlan2Hs.ag" #-} + _hdIruledefs `uwSetUnion` _tlIruledefs + {-# LINE 1697 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 419, column 34) + _lhsOruleuses = + ({-# LINE 419 "ExecutionPlan2Hs.ag" #-} + _hdIruleuses `uwSetUnion` _tlIruleuses + {-# LINE 1703 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 333, column 35) + _lhsOsem_rules = + ({-# LINE 333 "ExecutionPlan2Hs.ag" #-} + _hdIsem_rules >-< _tlIsem_rules + {-# LINE 1709 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOusedrules = + ({-# LINE 176 "ExecutionPlan2Hs.ag" #-} + _lhsIusedrules + {-# LINE 1715 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOusedrules = + ({-# LINE 176 "ExecutionPlan2Hs.ag" #-} + _lhsIusedrules + {-# LINE 1721 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdImrules,_hdIruledefs,_hdIruleuses,_hdIsem_rules) = + hd_ _hdOusedrules + ( _tlImrules,_tlIruledefs,_tlIruleuses,_tlIsem_rules) = + tl_ _tlOusedrules + in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) +sem_ERules_Nil :: T_ERules +sem_ERules_Nil = + (T_ERules (\ _lhsIusedrules -> + (let _lhsOmrules :: (Map.Map Identifier PP_Doc) + _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) + _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) + _lhsOsem_rules :: PP_Doc + -- use rule "ExecutionPlan2Hs.ag"(line 334, column 32) + _lhsOmrules = + ({-# LINE 334 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1739 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 418, column 34) + _lhsOruledefs = + ({-# LINE 418 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1745 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 419, column 34) + _lhsOruleuses = + ({-# LINE 419 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1751 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 333, column 35) + _lhsOsem_rules = + ({-# LINE 333 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 1757 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) +-- ExecutionPlan ----------------------------------------------- +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + inhmap : Map.Map NontermIdent Attributes + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + options : Options + pragmaBlocks : String + synmap : Map.Map NontermIdent Attributes + textBlocks : PP_Doc + synthesized attribute: + debugoutput : PP_Doc + alternatives: + alternative ExecutionPlan: + child nonts : ENonterminals + child typeSyns : {TypeSyns} + child wrappers : {Set.Set NontermIdent} +-} +-- cata +sem_ExecutionPlan :: ExecutionPlan -> + T_ExecutionPlan +sem_ExecutionPlan (ExecutionPlan _nonts _typeSyns _wrappers ) = + (sem_ExecutionPlan_ExecutionPlan (sem_ENonterminals _nonts ) _typeSyns _wrappers ) +-- semantic domain +newtype T_ExecutionPlan = T_ExecutionPlan (PP_Doc -> + (Map.Map NontermIdent Attributes) -> + String -> + (String -> String -> String -> Bool -> String) -> + Options -> + String -> + (Map.Map NontermIdent Attributes) -> + PP_Doc -> + ( PP_Doc)) +data Inh_ExecutionPlan = Inh_ExecutionPlan {importBlocks_Inh_ExecutionPlan :: PP_Doc,inhmap_Inh_ExecutionPlan :: (Map.Map NontermIdent Attributes),mainName_Inh_ExecutionPlan :: String,moduleHeader_Inh_ExecutionPlan :: (String -> String -> String -> Bool -> String),options_Inh_ExecutionPlan :: Options,pragmaBlocks_Inh_ExecutionPlan :: String,synmap_Inh_ExecutionPlan :: (Map.Map NontermIdent Attributes),textBlocks_Inh_ExecutionPlan :: PP_Doc} +data Syn_ExecutionPlan = Syn_ExecutionPlan {debugoutput_Syn_ExecutionPlan :: PP_Doc} +wrap_ExecutionPlan :: T_ExecutionPlan -> + Inh_ExecutionPlan -> + Syn_ExecutionPlan +wrap_ExecutionPlan (T_ExecutionPlan sem ) (Inh_ExecutionPlan _lhsIimportBlocks _lhsIinhmap _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks ) = + (let ( _lhsOdebugoutput) = sem _lhsIimportBlocks _lhsIinhmap _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks + in (Syn_ExecutionPlan _lhsOdebugoutput )) +sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals -> + TypeSyns -> + (Set.Set NontermIdent) -> + T_ExecutionPlan +sem_ExecutionPlan_ExecutionPlan (T_ENonterminals nonts_ ) typeSyns_ wrappers_ = + (T_ExecutionPlan (\ _lhsIimportBlocks + _lhsIinhmap + _lhsImainName + _lhsImoduleHeader + _lhsIoptions + _lhsIpragmaBlocks + _lhsIsynmap + _lhsItextBlocks -> + (let _lhsOdebugoutput :: PP_Doc + _nontsOwrappers :: (Set.Set NontermIdent) + _nontsOtypeSyns :: TypeSyns + _nontsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _nontsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _nontsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _nontsOinhmap :: (Map.Map NontermIdent Attributes) + _nontsOoptions :: Options + _nontsOsynmap :: (Map.Map NontermIdent Attributes) + _nontsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _nontsIdebugoutput :: PP_Doc + _nontsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _nontsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 40, column 19) + _lhsOdebugoutput = + ({-# LINE 40 "ExecutionPlan2Hs.ag" #-} + "{-# LANGUAGE Rank2Types, GADTs, EmptyDataDecls #-}" + >-< _lhsIpragmaBlocks + >-< _lhsImoduleHeader _lhsImainName "" "" False + >-< "import Control.Monad.Identity" + >-< _lhsIimportBlocks + >-< _lhsItextBlocks + >-< _nontsIdebugoutput + {-# LINE 1839 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 51, column 19) + _nontsOwrappers = + ({-# LINE 51 "ExecutionPlan2Hs.ag" #-} + wrappers_ + {-# LINE 1845 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 71, column 19) + _nontsOtypeSyns = + ({-# LINE 71 "ExecutionPlan2Hs.ag" #-} + typeSyns_ + {-# LINE 1851 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 384, column 19) + _nontsOallchildvisit = + ({-# LINE 384 "ExecutionPlan2Hs.ag" #-} + _nontsIchildvisit + {-# LINE 1857 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 450, column 19) + _nontsOavisitdefs = + ({-# LINE 450 "ExecutionPlan2Hs.ag" #-} + _nontsIvisitdefs + {-# LINE 1863 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 451, column 19) + _nontsOavisituses = + ({-# LINE 451 "ExecutionPlan2Hs.ag" #-} + _nontsIvisituses + {-# LINE 1869 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOinhmap = + ({-# LINE 122 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1875 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOoptions = + ({-# LINE 30 "ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 1881 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOsynmap = + ({-# LINE 123 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1887 "ExecutionPlan2Hs.hs" #-} + ) + ( _nontsIchildvisit,_nontsIdebugoutput,_nontsIvisitdefs,_nontsIvisituses) = + nonts_ _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOinhmap _nontsOoptions _nontsOsynmap _nontsOtypeSyns _nontsOwrappers + in ( _lhsOdebugoutput))) ) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Set.Set String + semfunc : PP_Doc + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = T_Expression (( (Set.Set String),PP_Doc)) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {attrs_Syn_Expression :: (Set.Set String),semfunc_Syn_Expression :: PP_Doc} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression ) = + (let ( _lhsOattrs,_lhsOsemfunc) = sem + in (Syn_Expression _lhsOattrs _lhsOsemfunc )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOattrs :: (Set.Set String) + _lhsOsemfunc :: PP_Doc + -- "ExecutionPlan2Hs.ag"(line 368, column 16) + _lhsOattrs = + ({-# LINE 368 "ExecutionPlan2Hs.ag" #-} + Set.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 1928 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 369, column 16) + _lhsOsemfunc = + ({-# LINE 369 "ExecutionPlan2Hs.ag" #-} + vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 1934 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOsemfunc)) ) +-- HsToken ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Set.Set String + tok : (Pos,String) + alternatives: + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local addTrace : _ + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local tok : _ + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGField _field _attr _pos _rdesc ) = + (sem_HsToken_AGField _field _attr _pos _rdesc ) +sem_HsToken (AGLocal _var _pos _rdesc ) = + (sem_HsToken_AGLocal _var _pos _rdesc ) +sem_HsToken (CharToken _value _pos ) = + (sem_HsToken_CharToken _value _pos ) +sem_HsToken (Err _mesg _pos ) = + (sem_HsToken_Err _mesg _pos ) +sem_HsToken (HsToken _value _pos ) = + (sem_HsToken_HsToken _value _pos ) +sem_HsToken (StrToken _value _pos ) = + (sem_HsToken_StrToken _value _pos ) +-- semantic domain +newtype T_HsToken = T_HsToken (( (Set.Set String),((Pos,String)))) +data Inh_HsToken = Inh_HsToken {} +data Syn_HsToken = Syn_HsToken {attrs_Syn_HsToken :: (Set.Set String),tok_Syn_HsToken :: ((Pos,String))} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem ) (Inh_HsToken ) = + (let ( _lhsOattrs,_lhsOtok) = sem + in (Syn_HsToken _lhsOattrs _lhsOtok )) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (let _lhsOattrs :: (Set.Set String) + _lhsOtok :: ((Pos,String)) + -- "ExecutionPlan2Hs.ag"(line 363, column 15) + _lhsOattrs = + ({-# LINE 363 "ExecutionPlan2Hs.ag" #-} + Set.singleton $ attrname True field_ attr_ + {-# LINE 2007 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 482, column 8) + _addTrace = + ({-# LINE 482 "ExecutionPlan2Hs.ag" #-} + case rdesc_ of + Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" + Nothing -> id + {-# LINE 2015 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 485, column 8) + _lhsOtok = + ({-# LINE 485 "ExecutionPlan2Hs.ag" #-} + (pos_, _addTrace $ attrname True field_ attr_) + {-# LINE 2021 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (let _lhsOattrs :: (Set.Set String) + _lhsOtok :: ((Pos,String)) + -- "ExecutionPlan2Hs.ag"(line 362, column 15) + _lhsOattrs = + ({-# LINE 362 "ExecutionPlan2Hs.ag" #-} + Set.singleton $ locname var_ + {-# LINE 2035 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 477, column 15) + _tok = + ({-# LINE 477 "ExecutionPlan2Hs.ag" #-} + (pos_,locname var_) + {-# LINE 2041 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _lhsOtok = + ({-# LINE 480 "ExecutionPlan2Hs.ag" #-} + _tok + {-# LINE 2047 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 489, column 16) + _lhsOtok = + ({-# LINE 489 "ExecutionPlan2Hs.ag" #-} + (pos_, if null value_ + then "" + else showCharShort (head value_) + ) + {-# LINE 2063 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 360, column 37) + _lhsOattrs = + ({-# LINE 360 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2069 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 495, column 16) + _lhsOtok = + ({-# LINE 495 "ExecutionPlan2Hs.ag" #-} + (pos_, "") + {-# LINE 2082 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 360, column 37) + _lhsOattrs = + ({-# LINE 360 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2088 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 487, column 14) + _lhsOtok = + ({-# LINE 487 "ExecutionPlan2Hs.ag" #-} + (pos_, value_) + {-# LINE 2101 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 360, column 37) + _lhsOattrs = + ({-# LINE 360 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2107 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 494, column 16) + _lhsOtok = + ({-# LINE 494 "ExecutionPlan2Hs.ag" #-} + (pos_, showStrShort value_) + {-# LINE 2120 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 360, column 37) + _lhsOattrs = + ({-# LINE 360 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2126 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +-- HsTokens ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + tks : [(Pos,String)] + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) ) +-- semantic domain +newtype T_HsTokens = T_HsTokens (( ([(Pos,String)]))) +data Inh_HsTokens = Inh_HsTokens {} +data Syn_HsTokens = Syn_HsTokens {tks_Syn_HsTokens :: ([(Pos,String)])} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens ) = + (let ( _lhsOtks) = sem + in (Syn_HsTokens _lhsOtks )) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) = + (T_HsTokens (let _lhsOtks :: ([(Pos,String)]) + _hdIattrs :: (Set.Set String) + _hdItok :: ((Pos,String)) + _tlItks :: ([(Pos,String)]) + -- "ExecutionPlan2Hs.ag"(line 472, column 10) + _lhsOtks = + ({-# LINE 472 "ExecutionPlan2Hs.ag" #-} + _hdItok : _tlItks + {-# LINE 2167 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIattrs,_hdItok) = + hd_ + ( _tlItks) = + tl_ + in ( _lhsOtks)) ) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (let _lhsOtks :: ([(Pos,String)]) + -- "ExecutionPlan2Hs.ag"(line 473, column 10) + _lhsOtks = + ({-# LINE 473 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 2181 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOtks)) ) +-- HsTokensRoot ------------------------------------------------ +{- + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +-- cata +sem_HsTokensRoot :: HsTokensRoot -> + T_HsTokensRoot +sem_HsTokensRoot (HsTokensRoot _tokens ) = + (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens ) ) +-- semantic domain +newtype T_HsTokensRoot = T_HsTokensRoot (( )) +data Inh_HsTokensRoot = Inh_HsTokensRoot {} +data Syn_HsTokensRoot = Syn_HsTokensRoot {} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot ) = + (let ( ) = sem + in (Syn_HsTokensRoot )) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) = + (T_HsTokensRoot (let _tokensItks :: ([(Pos,String)]) + ( _tokensItks) = + tokens_ + in ( )) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Set.Set String + copy : SELF + sem_lhs : PP_Doc + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( (Set.Set String),Pattern ,PP_Doc)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {attrs_Syn_Pattern :: (Set.Set String),copy_Syn_Pattern :: Pattern ,sem_lhs_Syn_Pattern :: PP_Doc} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs) = sem + in (Syn_Pattern _lhsOattrs _lhsOcopy _lhsOsem_lhs )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + _patIattrs :: (Set.Set String) + _patIcopy :: Pattern + _patIsem_lhs :: PP_Doc + _partsIattrs :: (Set.Set String) + _partsIcopy :: Patterns + _partsIsem_lhs :: ([PP_Doc]) + -- "ExecutionPlan2Hs.ag"(line 353, column 17) + _lhsOsem_lhs = + ({-# LINE 353 "ExecutionPlan2Hs.ag" #-} + text $ attrname False field_ attr_ + {-# LINE 2288 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 354, column 17) + _lhsOattrs = + ({-# LINE 354 "ExecutionPlan2Hs.ag" #-} + Set.singleton $ attrname False field_ attr_ + {-# LINE 2294 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 2300 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2306 "ExecutionPlan2Hs.hs" #-} + ) + ( _patIattrs,_patIcopy,_patIsem_lhs) = + pat_ + ( _partsIattrs,_partsIcopy,_partsIsem_lhs) = + parts_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + _patsIattrs :: (Set.Set String) + _patsIcopy :: Patterns + _patsIsem_lhs :: ([PP_Doc]) + -- "ExecutionPlan2Hs.ag"(line 356, column 17) + _lhsOsem_lhs = + ({-# LINE 356 "ExecutionPlan2Hs.ag" #-} + pp_parens $ name_ >#< hv_sp _patsIsem_lhs + {-# LINE 2327 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 347, column 27) + _lhsOattrs = + ({-# LINE 347 "ExecutionPlan2Hs.ag" #-} + _patsIattrs + {-# LINE 2333 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 2339 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2345 "ExecutionPlan2Hs.hs" #-} + ) + ( _patsIattrs,_patsIcopy,_patsIsem_lhs) = + pats_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + _patIattrs :: (Set.Set String) + _patIcopy :: Pattern + _patIsem_lhs :: PP_Doc + -- "ExecutionPlan2Hs.ag"(line 358, column 17) + _lhsOsem_lhs = + ({-# LINE 358 "ExecutionPlan2Hs.ag" #-} + text "~" >|< pp_parens _patIsem_lhs + {-# LINE 2363 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 347, column 27) + _lhsOattrs = + ({-# LINE 347 "ExecutionPlan2Hs.ag" #-} + _patIattrs + {-# LINE 2369 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 2375 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2381 "ExecutionPlan2Hs.hs" #-} + ) + ( _patIattrs,_patIcopy,_patIsem_lhs) = + pat_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + _patsIattrs :: (Set.Set String) + _patsIcopy :: Patterns + _patsIsem_lhs :: ([PP_Doc]) + -- "ExecutionPlan2Hs.ag"(line 355, column 17) + _lhsOsem_lhs = + ({-# LINE 355 "ExecutionPlan2Hs.ag" #-} + pp_block "(" ")" "," _patsIsem_lhs + {-# LINE 2400 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 347, column 27) + _lhsOattrs = + ({-# LINE 347 "ExecutionPlan2Hs.ag" #-} + _patsIattrs + {-# LINE 2406 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 2412 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2418 "ExecutionPlan2Hs.hs" #-} + ) + ( _patsIattrs,_patsIcopy,_patsIsem_lhs) = + pats_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + -- "ExecutionPlan2Hs.ag"(line 357, column 17) + _lhsOsem_lhs = + ({-# LINE 357 "ExecutionPlan2Hs.ag" #-} + text "_" + {-# LINE 2433 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 347, column 27) + _lhsOattrs = + ({-# LINE 347 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2439 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 2445 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2451 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Set.Set String + copy : SELF + sem_lhs : [PP_Doc] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( (Set.Set String),Patterns ,([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {attrs_Syn_Patterns :: (Set.Set String),copy_Syn_Patterns :: Patterns ,sem_lhs_Syn_Patterns :: ([PP_Doc])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs) = sem + in (Syn_Patterns _lhsOattrs _lhsOcopy _lhsOsem_lhs )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOattrs :: (Set.Set String) + _lhsOsem_lhs :: ([PP_Doc]) + _lhsOcopy :: Patterns + _hdIattrs :: (Set.Set String) + _hdIcopy :: Pattern + _hdIsem_lhs :: PP_Doc + _tlIattrs :: (Set.Set String) + _tlIcopy :: Patterns + _tlIsem_lhs :: ([PP_Doc]) + -- use rule "ExecutionPlan2Hs.ag"(line 349, column 27) + _lhsOattrs = + ({-# LINE 349 "ExecutionPlan2Hs.ag" #-} + _hdIattrs `Set.union` _tlIattrs + {-# LINE 2503 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 350, column 29) + _lhsOsem_lhs = + ({-# LINE 350 "ExecutionPlan2Hs.ag" #-} + _hdIsem_lhs : _tlIsem_lhs + {-# LINE 2509 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 2515 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2521 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIattrs,_hdIcopy,_hdIsem_lhs) = + hd_ + ( _tlIattrs,_tlIcopy,_tlIsem_lhs) = + tl_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOattrs :: (Set.Set String) + _lhsOsem_lhs :: ([PP_Doc]) + _lhsOcopy :: Patterns + -- use rule "ExecutionPlan2Hs.ag"(line 349, column 27) + _lhsOattrs = + ({-# LINE 349 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2537 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 350, column 29) + _lhsOsem_lhs = + ({-# LINE 350 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 2543 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 2549 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2555 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +-- Visit ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + allintramap : Map.Map StateIdentifier (Set.Set String) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + childintros : Map.Map Identifier PP_Doc + inhmap : Attributes + mrules : Map.Map Identifier PP_Doc + nt : NontermIdent + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + synmap : Attributes + terminaldefs : Set.Set String + synthesized attributes: + allvisits : (VisitIdentifier,StateIdentifier, StateIdentifier) + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + intramap : Map.Map StateIdentifier (Set.Set String) + sem_visit : (StateIdentifier,PP_Doc) + t_visits : PP_Doc + usedrules : Set.Set Identifier + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative Visit: + child ident : {VisitIdentifier} + child from : {StateIdentifier} + child to : {StateIdentifier} + child inh : {Set.Set Identifier} + child syn : {Set.Set Identifier} + child steps : VisitSteps + visit 0: + local inhpart : _ + local synpart : _ + local inhargs : _ + local synargs : _ + local nextargs : _ + local sem_steps : _ + local nextintra : _ + local uses : _ + local defs : _ +-} +-- cata +sem_Visit :: Visit -> + T_Visit +sem_Visit (Visit _ident _from _to _inh _syn _steps ) = + (sem_Visit_Visit _ident _from _to _inh _syn (sem_VisitSteps _steps ) ) +-- semantic domain +newtype T_Visit = T_Visit ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map StateIdentifier (Set.Set String)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map Identifier PP_Doc) -> + Attributes -> + (Map.Map Identifier PP_Doc) -> + NontermIdent -> + (Map.Map Identifier (Set.Set String)) -> + (Map.Map Identifier (Set.Set String)) -> + Attributes -> + (Set.Set String) -> + ( ((VisitIdentifier,StateIdentifier, StateIdentifier)),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),(Map.Map StateIdentifier (Set.Set String)),( (StateIdentifier,PP_Doc) ),PP_Doc,(Set.Set Identifier),(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_Visit = Inh_Visit {allchildvisit_Inh_Visit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allintramap_Inh_Visit :: (Map.Map StateIdentifier (Set.Set String)),avisitdefs_Inh_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_Visit :: (Map.Map Identifier PP_Doc),inhmap_Inh_Visit :: Attributes,mrules_Inh_Visit :: (Map.Map Identifier PP_Doc),nt_Inh_Visit :: NontermIdent,ruledefs_Inh_Visit :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_Visit :: (Map.Map Identifier (Set.Set String)),synmap_Inh_Visit :: Attributes,terminaldefs_Inh_Visit :: (Set.Set String)} +data Syn_Visit = Syn_Visit {allvisits_Syn_Visit :: ((VisitIdentifier,StateIdentifier, StateIdentifier)),childvisit_Syn_Visit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),intramap_Syn_Visit :: (Map.Map StateIdentifier (Set.Set String)),sem_visit_Syn_Visit :: ( (StateIdentifier,PP_Doc) ),t_visits_Syn_Visit :: PP_Doc,usedrules_Syn_Visit :: (Set.Set Identifier),visitdefs_Syn_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_Visit :: T_Visit -> + Inh_Visit -> + Syn_Visit +wrap_Visit (T_Visit sem ) (Inh_Visit _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs ) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs + in (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOintramap _lhsOsem_visit _lhsOt_visits _lhsOusedrules _lhsOvisitdefs _lhsOvisituses )) +sem_Visit_Visit :: VisitIdentifier -> + StateIdentifier -> + StateIdentifier -> + (Set.Set Identifier) -> + (Set.Set Identifier) -> + T_VisitSteps -> + T_Visit +sem_Visit_Visit ident_ from_ to_ inh_ syn_ (T_VisitSteps steps_ ) = + (T_Visit (\ _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsIinhmap + _lhsImrules + _lhsInt + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ((VisitIdentifier,StateIdentifier, StateIdentifier)) + _lhsOt_visits :: PP_Doc + _lhsOsem_visit :: ( (StateIdentifier,PP_Doc) ) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOusedrules :: (Set.Set Identifier) + _stepsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _stepsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _stepsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _stepsOchildintros :: (Map.Map Identifier PP_Doc) + _stepsOmrules :: (Map.Map Identifier PP_Doc) + _stepsOruledefs :: (Map.Map Identifier (Set.Set String)) + _stepsOruleuses :: (Map.Map Identifier (Set.Set String)) + _stepsIdefs :: (Set.Set String) + _stepsIsem_steps :: PP_Doc + _stepsIusedrules :: (Set.Set Identifier) + _stepsIuses :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 141, column 11) + _lhsOallvisits = + ({-# LINE 141 "ExecutionPlan2Hs.ag" #-} + (ident_, from_, to_) + {-# LINE 2672 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 197, column 11) + _lhsOt_visits = + ({-# LINE 197 "ExecutionPlan2Hs.ag" #-} + "type" >#< "T_" >|< _lhsInt >|< "_v" >|< ident_ >#< "=" >#< _inhpart >#< + "Identity" >#< "(" >#< _synpart >#< "T_" >|< _lhsInt >|< "_s" >|< to_ >#< ")" + {-# LINE 2679 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 199, column 11) + _inhpart = + ({-# LINE 199 "ExecutionPlan2Hs.ag" #-} + if Set.null inh_ + then empty + else (ppSpaced $ map (\i -> (\x -> x >#< "->") $ typeToHaskellString (Just _lhsInt) [] + $ fromJust $ Map.lookup i _lhsIinhmap) $ Set.toList inh_) + {-# LINE 2688 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 203, column 11) + _synpart = + ({-# LINE 203 "ExecutionPlan2Hs.ag" #-} + if Set.null syn_ + then empty + else (ppCommas $ map (\i -> typeToHaskellString (Just _lhsInt) [] $ fromJust $ Map.lookup i _lhsIsynmap) $ Set.toList syn_) >#< "," + {-# LINE 2696 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 292, column 11) + _lhsOsem_visit = + ({-# LINE 292 "ExecutionPlan2Hs.ag" #-} + (from_, "v" >|< ident_ >#< "::" >#< "T_" >|< _lhsInt >|< "_v" >|< ident_ + >-< "v" >|< ident_ >#< (_inhargs _LHS True) >#< "=" >#< "do" + >-< indent 3 _sem_steps ) + {-# LINE 2704 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 295, column 11) + _inhargs = + ({-# LINE 295 "ExecutionPlan2Hs.ag" #-} + \chn inh -> ppSpaced $ map (\arg -> attrname inh chn arg) $ Set.toList inh_ + {-# LINE 2710 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 296, column 11) + _synargs = + ({-# LINE 296 "ExecutionPlan2Hs.ag" #-} + ppSpaced $ map (\arg -> attrname False _LHS arg >#< ",") $ Set.toList syn_ + {-# LINE 2716 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 297, column 11) + _nextargs = + ({-# LINE 297 "ExecutionPlan2Hs.ag" #-} + ppSpaced $ Set.toList $ maybe Set.empty id $ Map.lookup to_ _lhsIallintramap + {-# LINE 2722 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 298, column 11) + _sem_steps = + ({-# LINE 298 "ExecutionPlan2Hs.ag" #-} + _stepsIsem_steps + >-< "return" >#< "(" >#< _synargs >#< "st" >|< to_ >#< _nextargs >#< ")" + {-# LINE 2729 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 387, column 11) + _lhsOchildvisit = + ({-# LINE 387 "ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ $ \chn -> "(" >#< ppSpaced ( + map (\x -> attrname True chn x >#< ",") $ Set.toList syn_) >#< locname chn + >#< ")" >#< "<-" >#< "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< locname chn + >#< "K_" >|< _lhsInt >|< "_v" >|< ident_ >#< _inhargs chn False + {-# LINE 2738 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 413, column 11) + _lhsOintramap = + ({-# LINE 413 "ExecutionPlan2Hs.ag" #-} + Map.singleton from_ $ (_uses `Set.union` _nextintra ) `Set.difference` _defs + {-# LINE 2744 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 414, column 11) + _nextintra = + ({-# LINE 414 "ExecutionPlan2Hs.ag" #-} + maybe Set.empty id $ Map.lookup to_ _lhsIallintramap + {-# LINE 2750 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 415, column 11) + _uses = + ({-# LINE 415 "ExecutionPlan2Hs.ag" #-} + _stepsIuses + {-# LINE 2756 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 416, column 11) + _defs = + ({-# LINE 416 "ExecutionPlan2Hs.ag" #-} + _stepsIdefs `Set.union` (Set.map (lhsname True) inh_) `Set.union` _lhsIterminaldefs + {-# LINE 2762 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 440, column 11) + _lhsOvisitdefs = + ({-# LINE 440 "ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ syn_ + {-# LINE 2768 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 441, column 11) + _lhsOvisituses = + ({-# LINE 441 "ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ inh_ + {-# LINE 2774 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + _stepsIusedrules + {-# LINE 2780 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 381 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 2786 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 2792 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 2798 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 2804 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 2810 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 2816 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 2822 "ExecutionPlan2Hs.hs" #-} + ) + ( _stepsIdefs,_stepsIsem_steps,_stepsIusedrules,_stepsIuses) = + steps_ _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildintros _stepsOmrules _stepsOruledefs _stepsOruleuses + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) +-- VisitStep --------------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + childintros : Map.Map Identifier PP_Doc + mrules : Map.Map Identifier PP_Doc + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + synthesized attributes: + defs : Set.Set String + sem_steps : PP_Doc + usedrules : Set.Set Identifier + uses : Set.Set String + alternatives: + alternative ChildIntro: + child child : {Identifier} + alternative ChildVisit: + child child : {Identifier} + child nonterm : {NontermIdent} + child visit : {VisitIdentifier} + alternative Sem: + child name : {Identifier} + alternative Sim: + child steps : VisitSteps +-} +-- cata +sem_VisitStep :: VisitStep -> + T_VisitStep +sem_VisitStep (ChildIntro _child ) = + (sem_VisitStep_ChildIntro _child ) +sem_VisitStep (ChildVisit _child _nonterm _visit ) = + (sem_VisitStep_ChildVisit _child _nonterm _visit ) +sem_VisitStep (Sem _name ) = + (sem_VisitStep_Sem _name ) +sem_VisitStep (Sim _steps ) = + (sem_VisitStep_Sim (sem_VisitSteps _steps ) ) +-- semantic domain +newtype T_VisitStep = T_VisitStep ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map Identifier PP_Doc) -> + (Map.Map Identifier PP_Doc) -> + (Map.Map Identifier (Set.Set String)) -> + (Map.Map Identifier (Set.Set String)) -> + ( (Set.Set String),PP_Doc,(Set.Set Identifier),(Set.Set String))) +data Inh_VisitStep = Inh_VisitStep {allchildvisit_Inh_VisitStep :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_VisitStep :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_VisitStep :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_VisitStep :: (Map.Map Identifier PP_Doc),mrules_Inh_VisitStep :: (Map.Map Identifier PP_Doc),ruledefs_Inh_VisitStep :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_VisitStep :: (Map.Map Identifier (Set.Set String))} +data Syn_VisitStep = Syn_VisitStep {defs_Syn_VisitStep :: (Set.Set String),sem_steps_Syn_VisitStep :: PP_Doc,usedrules_Syn_VisitStep :: (Set.Set Identifier),uses_Syn_VisitStep :: (Set.Set String)} +wrap_VisitStep :: T_VisitStep -> + Inh_VisitStep -> + Syn_VisitStep +wrap_VisitStep (T_VisitStep sem ) (Inh_VisitStep _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses ) = + (let ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses + in (Syn_VisitStep _lhsOdefs _lhsOsem_steps _lhsOusedrules _lhsOuses )) +sem_VisitStep_ChildIntro :: Identifier -> + T_VisitStep +sem_VisitStep_ChildIntro child_ = + (T_VisitStep (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOsem_steps :: PP_Doc + _lhsOdefs :: (Set.Set String) + _lhsOusedrules :: (Set.Set Identifier) + _lhsOuses :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 307, column 16) + _lhsOsem_steps = + ({-# LINE 307 "ExecutionPlan2Hs.ag" #-} + maybe (error $ "Child " ++ show child_ ++ " not found in: " ++ show _lhsIchildintros) id $ Map.lookup child_ _lhsIchildintros + {-# LINE 2901 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 458, column 16) + _lhsOdefs = + ({-# LINE 458 "ExecutionPlan2Hs.ag" #-} + Set.singleton $ locname child_ + {-# LINE 2907 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2913 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 454, column 38) + _lhsOuses = + ({-# LINE 454 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2919 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +sem_VisitStep_ChildVisit :: Identifier -> + NontermIdent -> + VisitIdentifier -> + T_VisitStep +sem_VisitStep_ChildVisit child_ nonterm_ visit_ = + (T_VisitStep (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOsem_steps :: PP_Doc + _lhsOdefs :: (Set.Set String) + _lhsOuses :: (Set.Set String) + _lhsOusedrules :: (Set.Set Identifier) + -- "ExecutionPlan2Hs.ag"(line 308, column 16) + _lhsOsem_steps = + ({-# LINE 308 "ExecutionPlan2Hs.ag" #-} + (maybe (error "Visit not found") id $ Map.lookup visit_ _lhsIallchildvisit) $ child_ + {-# LINE 2942 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 459, column 16) + _lhsOdefs = + ({-# LINE 459 "ExecutionPlan2Hs.ag" #-} + maybe (error "Visit not found") (Set.map $ attrname True child_) $ Map.lookup visit_ _lhsIavisitdefs + {-# LINE 2948 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 460, column 16) + _lhsOuses = + ({-# LINE 460 "ExecutionPlan2Hs.ag" #-} + Set.insert (locname child_) $ + maybe (error "Visit not found") (Set.map $ attrname False child_) $ Map.lookup visit_ _lhsIavisituses + {-# LINE 2955 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2961 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +sem_VisitStep_Sem :: Identifier -> + T_VisitStep +sem_VisitStep_Sem name_ = + (T_VisitStep (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOusedrules :: (Set.Set Identifier) + _lhsOsem_steps :: PP_Doc + _lhsOdefs :: (Set.Set String) + _lhsOuses :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 179, column 9) + _lhsOusedrules = + ({-# LINE 179 "ExecutionPlan2Hs.ag" #-} + Set.singleton name_ + {-# LINE 2982 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 306, column 16) + _lhsOsem_steps = + ({-# LINE 306 "ExecutionPlan2Hs.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsImrules + {-# LINE 2988 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 456, column 16) + _lhsOdefs = + ({-# LINE 456 "ExecutionPlan2Hs.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs + {-# LINE 2994 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 457, column 16) + _lhsOuses = + ({-# LINE 457 "ExecutionPlan2Hs.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses + {-# LINE 3000 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +sem_VisitStep_Sim :: T_VisitSteps -> + T_VisitStep +sem_VisitStep_Sim (T_VisitSteps steps_ ) = + (T_VisitStep (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOdefs :: (Set.Set String) + _lhsOsem_steps :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOuses :: (Set.Set String) + _stepsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _stepsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _stepsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _stepsOchildintros :: (Map.Map Identifier PP_Doc) + _stepsOmrules :: (Map.Map Identifier PP_Doc) + _stepsOruledefs :: (Map.Map Identifier (Set.Set String)) + _stepsOruleuses :: (Map.Map Identifier (Set.Set String)) + _stepsIdefs :: (Set.Set String) + _stepsIsem_steps :: PP_Doc + _stepsIusedrules :: (Set.Set Identifier) + _stepsIuses :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 453, column 38) + _lhsOdefs = + ({-# LINE 453 "ExecutionPlan2Hs.ag" #-} + _stepsIdefs + {-# LINE 3032 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 304, column 43) + _lhsOsem_steps = + ({-# LINE 304 "ExecutionPlan2Hs.ag" #-} + _stepsIsem_steps + {-# LINE 3038 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + _stepsIusedrules + {-# LINE 3044 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 454, column 38) + _lhsOuses = + ({-# LINE 454 "ExecutionPlan2Hs.ag" #-} + _stepsIuses + {-# LINE 3050 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 381 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3056 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3062 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3068 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3074 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3080 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3086 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3092 "ExecutionPlan2Hs.hs" #-} + ) + ( _stepsIdefs,_stepsIsem_steps,_stepsIusedrules,_stepsIuses) = + steps_ _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildintros _stepsOmrules _stepsOruledefs _stepsOruleuses + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +-- VisitSteps -------------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + childintros : Map.Map Identifier PP_Doc + mrules : Map.Map Identifier PP_Doc + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + synthesized attributes: + defs : Set.Set String + sem_steps : PP_Doc + usedrules : Set.Set Identifier + uses : Set.Set String + alternatives: + alternative Cons: + child hd : VisitStep + child tl : VisitSteps + alternative Nil: +-} +-- cata +sem_VisitSteps :: VisitSteps -> + T_VisitSteps +sem_VisitSteps list = + (Prelude.foldr sem_VisitSteps_Cons sem_VisitSteps_Nil (Prelude.map sem_VisitStep list) ) +-- semantic domain +newtype T_VisitSteps = T_VisitSteps ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map Identifier PP_Doc) -> + (Map.Map Identifier PP_Doc) -> + (Map.Map Identifier (Set.Set String)) -> + (Map.Map Identifier (Set.Set String)) -> + ( (Set.Set String),PP_Doc,(Set.Set Identifier),(Set.Set String))) +data Inh_VisitSteps = Inh_VisitSteps {allchildvisit_Inh_VisitSteps :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_VisitSteps :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_VisitSteps :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_VisitSteps :: (Map.Map Identifier PP_Doc),mrules_Inh_VisitSteps :: (Map.Map Identifier PP_Doc),ruledefs_Inh_VisitSteps :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_VisitSteps :: (Map.Map Identifier (Set.Set String))} +data Syn_VisitSteps = Syn_VisitSteps {defs_Syn_VisitSteps :: (Set.Set String),sem_steps_Syn_VisitSteps :: PP_Doc,usedrules_Syn_VisitSteps :: (Set.Set Identifier),uses_Syn_VisitSteps :: (Set.Set String)} +wrap_VisitSteps :: T_VisitSteps -> + Inh_VisitSteps -> + Syn_VisitSteps +wrap_VisitSteps (T_VisitSteps sem ) (Inh_VisitSteps _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses ) = + (let ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses + in (Syn_VisitSteps _lhsOdefs _lhsOsem_steps _lhsOusedrules _lhsOuses )) +sem_VisitSteps_Cons :: T_VisitStep -> + T_VisitSteps -> + T_VisitSteps +sem_VisitSteps_Cons (T_VisitStep hd_ ) (T_VisitSteps tl_ ) = + (T_VisitSteps (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOdefs :: (Set.Set String) + _lhsOsem_steps :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOuses :: (Set.Set String) + _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOchildintros :: (Map.Map Identifier PP_Doc) + _hdOmrules :: (Map.Map Identifier PP_Doc) + _hdOruledefs :: (Map.Map Identifier (Set.Set String)) + _hdOruleuses :: (Map.Map Identifier (Set.Set String)) + _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOchildintros :: (Map.Map Identifier PP_Doc) + _tlOmrules :: (Map.Map Identifier PP_Doc) + _tlOruledefs :: (Map.Map Identifier (Set.Set String)) + _tlOruleuses :: (Map.Map Identifier (Set.Set String)) + _hdIdefs :: (Set.Set String) + _hdIsem_steps :: PP_Doc + _hdIusedrules :: (Set.Set Identifier) + _hdIuses :: (Set.Set String) + _tlIdefs :: (Set.Set String) + _tlIsem_steps :: PP_Doc + _tlIusedrules :: (Set.Set Identifier) + _tlIuses :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 453, column 38) + _lhsOdefs = + ({-# LINE 453 "ExecutionPlan2Hs.ag" #-} + _hdIdefs `Set.union` _tlIdefs + {-# LINE 3182 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 304, column 43) + _lhsOsem_steps = + ({-# LINE 304 "ExecutionPlan2Hs.ag" #-} + _hdIsem_steps >-< _tlIsem_steps + {-# LINE 3188 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + _hdIusedrules `Set.union` _tlIusedrules + {-# LINE 3194 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 454, column 38) + _lhsOuses = + ({-# LINE 454 "ExecutionPlan2Hs.ag" #-} + _hdIuses `Set.union` _tlIuses + {-# LINE 3200 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 381 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3206 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3212 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3218 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3224 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3230 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3236 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3242 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 381 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3248 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3254 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3260 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3266 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3272 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3278 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3284 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIdefs,_hdIsem_steps,_hdIusedrules,_hdIuses) = + hd_ _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildintros _hdOmrules _hdOruledefs _hdOruleuses + ( _tlIdefs,_tlIsem_steps,_tlIusedrules,_tlIuses) = + tl_ _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildintros _tlOmrules _tlOruledefs _tlOruleuses + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +sem_VisitSteps_Nil :: T_VisitSteps +sem_VisitSteps_Nil = + (T_VisitSteps (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOdefs :: (Set.Set String) + _lhsOsem_steps :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOuses :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 453, column 38) + _lhsOdefs = + ({-# LINE 453 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 3308 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 304, column 43) + _lhsOsem_steps = + ({-# LINE 304 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 3314 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 3320 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 454, column 38) + _lhsOuses = + ({-# LINE 454 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 3326 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +-- Visits ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + allintramap : Map.Map StateIdentifier (Set.Set String) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + childintros : Map.Map Identifier PP_Doc + inhmap : Attributes + mrules : Map.Map Identifier PP_Doc + nt : NontermIdent + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + synmap : Attributes + terminaldefs : Set.Set String + synthesized attributes: + allvisits : [(VisitIdentifier,StateIdentifier, StateIdentifier)] + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + intramap : Map.Map StateIdentifier (Set.Set String) + sem_visit : [(StateIdentifier,PP_Doc)] + t_visits : PP_Doc + usedrules : Set.Set Identifier + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative Cons: + child hd : Visit + child tl : Visits + alternative Nil: +-} +-- cata +sem_Visits :: Visits -> + T_Visits +sem_Visits list = + (Prelude.foldr sem_Visits_Cons sem_Visits_Nil (Prelude.map sem_Visit list) ) +-- semantic domain +newtype T_Visits = T_Visits ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map StateIdentifier (Set.Set String)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map Identifier PP_Doc) -> + Attributes -> + (Map.Map Identifier PP_Doc) -> + NontermIdent -> + (Map.Map Identifier (Set.Set String)) -> + (Map.Map Identifier (Set.Set String)) -> + Attributes -> + (Set.Set String) -> + ( ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),(Map.Map StateIdentifier (Set.Set String)),( [(StateIdentifier,PP_Doc)] ),PP_Doc,(Set.Set Identifier),(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_Visits = Inh_Visits {allchildvisit_Inh_Visits :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allintramap_Inh_Visits :: (Map.Map StateIdentifier (Set.Set String)),avisitdefs_Inh_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_Visits :: (Map.Map Identifier PP_Doc),inhmap_Inh_Visits :: Attributes,mrules_Inh_Visits :: (Map.Map Identifier PP_Doc),nt_Inh_Visits :: NontermIdent,ruledefs_Inh_Visits :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_Visits :: (Map.Map Identifier (Set.Set String)),synmap_Inh_Visits :: Attributes,terminaldefs_Inh_Visits :: (Set.Set String)} +data Syn_Visits = Syn_Visits {allvisits_Syn_Visits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),childvisit_Syn_Visits :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),intramap_Syn_Visits :: (Map.Map StateIdentifier (Set.Set String)),sem_visit_Syn_Visits :: ( [(StateIdentifier,PP_Doc)] ),t_visits_Syn_Visits :: PP_Doc,usedrules_Syn_Visits :: (Set.Set Identifier),visitdefs_Syn_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_Visits :: T_Visits -> + Inh_Visits -> + Syn_Visits +wrap_Visits (T_Visits sem ) (Inh_Visits _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs ) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs + in (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOintramap _lhsOsem_visit _lhsOt_visits _lhsOusedrules _lhsOvisitdefs _lhsOvisituses )) +sem_Visits_Cons :: T_Visit -> + T_Visits -> + T_Visits +sem_Visits_Cons (T_Visit hd_ ) (T_Visits tl_ ) = + (T_Visits (\ _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsIinhmap + _lhsImrules + _lhsInt + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) + _lhsOsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _lhsOt_visits :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdOallintramap :: (Map.Map StateIdentifier (Set.Set String)) + _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOchildintros :: (Map.Map Identifier PP_Doc) + _hdOinhmap :: Attributes + _hdOmrules :: (Map.Map Identifier PP_Doc) + _hdOnt :: NontermIdent + _hdOruledefs :: (Map.Map Identifier (Set.Set String)) + _hdOruleuses :: (Map.Map Identifier (Set.Set String)) + _hdOsynmap :: Attributes + _hdOterminaldefs :: (Set.Set String) + _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlOallintramap :: (Map.Map StateIdentifier (Set.Set String)) + _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOchildintros :: (Map.Map Identifier PP_Doc) + _tlOinhmap :: Attributes + _tlOmrules :: (Map.Map Identifier PP_Doc) + _tlOnt :: NontermIdent + _tlOruledefs :: (Map.Map Identifier (Set.Set String)) + _tlOruleuses :: (Map.Map Identifier (Set.Set String)) + _tlOsynmap :: Attributes + _tlOterminaldefs :: (Set.Set String) + _hdIallvisits :: ((VisitIdentifier,StateIdentifier, StateIdentifier)) + _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdIintramap :: (Map.Map StateIdentifier (Set.Set String)) + _hdIsem_visit :: ( (StateIdentifier,PP_Doc) ) + _hdIt_visits :: PP_Doc + _hdIusedrules :: (Set.Set Identifier) + _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlIintramap :: (Map.Map StateIdentifier (Set.Set String)) + _tlIsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _tlIt_visits :: PP_Doc + _tlIusedrules :: (Set.Set Identifier) + _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- use rule "ExecutionPlan2Hs.ag"(line 137, column 29) + _lhsOallvisits = + ({-# LINE 137 "ExecutionPlan2Hs.ag" #-} + _hdIallvisits : _tlIallvisits + {-# LINE 3455 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 3461 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 398, column 30) + _lhsOintramap = + ({-# LINE 398 "ExecutionPlan2Hs.ag" #-} + _hdIintramap `uwSetUnion` _tlIintramap + {-# LINE 3467 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 289, column 29) + _lhsOsem_visit = + ({-# LINE 289 "ExecutionPlan2Hs.ag" #-} + _hdIsem_visit : _tlIsem_visit + {-# LINE 3473 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 188, column 54) + _lhsOt_visits = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _hdIt_visits >-< _tlIt_visits + {-# LINE 3479 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + _hdIusedrules `Set.union` _tlIusedrules + {-# LINE 3485 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 3491 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 3497 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3503 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallintramap = + ({-# LINE 397 "ExecutionPlan2Hs.ag" #-} + _lhsIallintramap + {-# LINE 3509 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3515 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3521 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3527 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 3533 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3539 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 3545 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3551 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3557 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 3563 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOterminaldefs = + ({-# LINE 400 "ExecutionPlan2Hs.ag" #-} + _lhsIterminaldefs + {-# LINE 3569 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3575 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallintramap = + ({-# LINE 397 "ExecutionPlan2Hs.ag" #-} + _lhsIallintramap + {-# LINE 3581 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3587 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3593 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3599 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 3605 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3611 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 3617 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3623 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3629 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 3635 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOterminaldefs = + ({-# LINE 400 "ExecutionPlan2Hs.ag" #-} + _lhsIterminaldefs + {-# LINE 3641 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIallvisits,_hdIchildvisit,_hdIintramap,_hdIsem_visit,_hdIt_visits,_hdIusedrules,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildintros _hdOinhmap _hdOmrules _hdOnt _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs + ( _tlIallvisits,_tlIchildvisit,_tlIintramap,_tlIsem_visit,_tlIt_visits,_tlIusedrules,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildintros _tlOinhmap _tlOmrules _tlOnt _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) +sem_Visits_Nil :: T_Visits +sem_Visits_Nil = + (T_Visits (\ _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsIinhmap + _lhsImrules + _lhsInt + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) + _lhsOsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _lhsOt_visits :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- use rule "ExecutionPlan2Hs.ag"(line 137, column 29) + _lhsOallvisits = + ({-# LINE 137 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 3674 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 3680 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 398, column 30) + _lhsOintramap = + ({-# LINE 398 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 3686 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 289, column 29) + _lhsOsem_visit = + ({-# LINE 289 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 3692 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 188, column 54) + _lhsOt_visits = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 3698 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 3704 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 3710 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 3716 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) diff --git a/src-derived/Expression.hs b/src-derived/Expression.hs new file mode 100644 --- /dev/null +++ b/src-derived/Expression.hs @@ -0,0 +1,17 @@ + + +-- UUAGC 0.9.38.1 (Expression.ag) +module Expression where +{-# LINE 2 "Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 10 "../src-derived/Expression.hs" #-} +-- Expression -------------------------------------------------- +{- + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +data Expression = Expression (Pos) (([HsToken])) diff --git a/src-derived/GenerateCode.hs b/src-derived/GenerateCode.hs new file mode 100644 --- /dev/null +++ b/src-derived/GenerateCode.hs @@ -0,0 +1,8044 @@ + + +-- UUAGC 0.9.38.2 (GenerateCode.ag) +module GenerateCode where +{-# LINE 9 "GenerateCode.ag" #-} + +import CommonTypes +import SequentialTypes +import Code hiding (Type) +import qualified Code +import Options +import CodeSyntax +import ErrorMessages +import GrammarInfo +import DeclBlocks + +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Set as Set +import Data.Set(Set) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq) +import UU.Scanner.Position +import TokenDef +import HsToken +import HsTokenScanner + +import Data.List(partition,intersperse,intersect,(\\)) +import Maybe(fromJust,isJust) + +import Debug.Trace +{-# LINE 33 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 2 "./CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 41 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 48 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 2 "./DeclBlocks.ag" #-} + +import Code (Decl,Expr) +{-# LINE 53 "../src-derived/GenerateCode.hs" #-} +{-# LINE 107 "GenerateCode.ag" #-} + +-- remove possible @v references in the types of a data type. +cleanupArg :: String -> String +cleanupArg s + = case idEvalType (SimpleType s) of + SimpleType s' -> s' +{-# LINE 61 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 122 "GenerateCode.ag" #-} + +appContext :: ContextMap -> NontermIdent -> Code.Type -> Code.Type +appContext mp nt tp + = maybe tp (\ctx -> CtxApp (map (\(n,ns) -> (getName n, ns)) ctx) tp) $ Map.lookup nt mp + +appQuant :: QuantMap -> NontermIdent -> Code.Type -> Code.Type +appQuant mp nt tp + = foldr QuantApp tp $ Map.findWithDefault [] nt mp +{-# LINE 72 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 245 "GenerateCode.ag" #-} + +mkDecl True lhs rhs _ _ = Bind lhs rhs +mkDecl False lhs rhs s1 s2 = Decl lhs rhs s1 s2 + +unwrapSem :: Bool -> NontermIdent -> Expr -> Expr +unwrapSem False _ e = e +unwrapSem True nm e = Case e alts + where alts = [CaseAlt left right] + left = Fun (typeName nm 0) [SimpleExpr "x"] + right = SimpleExpr "x" +{-# LINE 85 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 411 "GenerateCode.ag" #-} + +substSelf nt tp = case tp of + NT t tps | t == _SELF -> Haskell (getName nt ++ " " ++ unwords tps) + _ -> tp +{-# LINE 92 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 534 "GenerateCode.ag" #-} + +mkLambdaArg :: String -> Maybe Code.Type -> Expr +mkLambdaArg nm Nothing = SimpleExpr nm +mkLambdaArg nm (Just tp) = TypedExpr (SimpleExpr nm) tp + +mkLambda :: Exprs -> Expr -> Expr +mkLambda [] e = e +mkLambda xs e = Lambda xs e + +mkSemFun :: Identifier -> Int -> Exprs -> Expr -> Expr +mkSemFun nt nr xs e = SemFun (typeName nt nr) xs e + +typeAppStrs nm params = TypeApp (SimpleType nm) (map SimpleType params) + +isHigherOrder :: Maybe (Maybe Type) -> Bool +isHigherOrder (Just Nothing) = True +isHigherOrder _ = False + +pickOrigType :: (Identifier, Type, Maybe (Maybe Type)) -> (Identifier, Type, Maybe (Maybe Type)) +pickOrigType (nm, tp, virt@(Just (Just x))) = (nm, x, virt) +pickOrigType x = x +{-# LINE 116 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 630 "GenerateCode.ag" #-} + +mkPartitionedFunction :: String -> Bool -> [Decl] -> [String] -> DeclBlocks -> ([Decl], Expr) +mkPartitionedFunction prefix optCase nextVisitDecls lastExprVars cpsTree + = let inh = Inh_DeclBlocksRoot { prefix_Inh_DeclBlocksRoot = prefix + , optCase_Inh_DeclBlocksRoot = optCase + , nextVisitDecls_Inh_DeclBlocksRoot = nextVisitDecls + , lastExprVars_Inh_DeclBlocksRoot = lastExprVars + } + sem = sem_DeclBlocksRoot (DeclBlocksRoot cpsTree) + syn = wrap_DeclBlocksRoot sem inh + in (lambdas_Syn_DeclBlocksRoot syn, firstCall_Syn_DeclBlocksRoot syn) +{-# LINE 130 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 680 "GenerateCode.ag" #-} + +freevars :: [String] -> [Decl] -> [String] +freevars additional decls + = Set.toList (allused `Set.difference` alldefined) + where + allused = Set.unions (Set.fromList additional : map usedvars decls) + alldefined = Set.unions (map definedvars decls) + + usedvars (Decl _ _ _ uses) = uses + usedvars _ = Set.empty + + definedvars (Decl _ _ defs _) = defs + definedvars _ = Set.empty + +mkBlockLambda :: Bool -> String -> [String] -> [Decl] -> Expr -> Decl +mkBlockLambda optCase name args decls expr + = Decl lhs rhs Set.empty Set.empty + where + lhs = Fun name (map SimpleExpr args) + rhs = mkLet optCase decls expr +{-# LINE 153 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 758 "GenerateCode.ag" #-} + +typeToCodeType :: Maybe NontermIdent -> [String] -> Type -> Code.Type +typeToCodeType mbNt params tp + = case tp of + NT nt tps | nt == _SELF -> NontermType (maybe "Unknown" getName mbNt) params + | otherwise -> NontermType (getName nt) tps + Haskell t -> SimpleType t + +evalType :: (String -> String) -> Code.Type -> Code.Type +evalType replf t + = chase t + where + chase t + = case t of + Arr l r -> Arr (chase l) (chase r) + TypeApp f as -> TypeApp (chase f) (map chase as) + TupleType tps -> TupleType (map chase tps) + UnboxedTupleType tps -> UnboxedTupleType (map chase tps) + Code.List tp -> Code.List (chase tp) + SimpleType txt -> let tks = lexTokens (initPos txt) txt + tks' = map replaceTok tks + txt' = unlines . showTokens . tokensToStrings $ tks' + in SimpleType txt' + TMaybe m -> TMaybe (chase m) + TEither l r -> TEither (chase l) (chase r) + TMap k v -> TMap (chase k) (chase v) + TIntMap v -> TIntMap (chase v) + _ -> t + + replaceTok t + = case t of + AGLocal v p _ -> HsToken (replf $ getName v) p + _ -> t + +idEvalType :: Code.Type -> Code.Type +idEvalType = evalType id +{-# LINE 192 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 883 "GenerateCode.ag" #-} + +-- for a virtual child that already existed as a child, returns +isFirstOrder :: Maybe (Maybe Type) -> Type -> Maybe Type +isFirstOrder Nothing tp = Just tp +isFirstOrder (Just x) _ = x +{-# LINE 200 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 903 "GenerateCode.ag" #-} + +makeLocalComment :: Int -> String -> Identifier -> Maybe Type -> String +makeLocalComment width what name tp = let x = getName name + y = maybe "_" (\t -> case t of (NT nt tps) -> getName nt ++ " " ++ unwords tps; Haskell t -> '{':t++"}") tp + in ( what ++ " " ++ x ++ replicate ((width - length x) `max` 0) ' ' ++ " : " ++ y ) + +{-# LINE 209 "../src-derived/GenerateCode.hs" #-} + +{-# LINE 934 "GenerateCode.ag" #-} + +-- Lets or nested Cases? +-- or even a do-expression? + +data DeclsType = DeclsLet | DeclsCase | DeclsDo + +mkDecls :: DeclsType -> Decls -> Expr -> Expr +mkDecls DeclsLet = mkLet False +mkDecls DeclsCase = mkLet True +mkDecls DeclsDo = \decls -> Do (map toBind decls) + where toBind (Decl lhs rhs _ _) = BindLet lhs rhs + toBind d = d + +mkLet :: Bool -> Decls -> Expr -> Expr +mkLet False decls body = Let decls body +mkLet True decls body = foldr oneCase body decls + +oneCase :: Decl -> Expr -> Expr +oneCase (Decl left rhs _ _) exp = Case rhs [CaseAlt left exp] +oneCase (Resume _ nt left rhs) exp = ResumeExpr nt rhs left exp +oneCase _ exp = exp + +-- Gives the name of the visit function +funname field 0 = show field ++ "_" +funname field nr = show field ++ "_" ++ show nr + +-- Gives the name of a semantic function +seqSemname :: String -> NontermIdent -> ConstructorIdent -> Int -> String +seqSemname pre nt con 0 = semname pre nt con +seqSemname pre nt con nr = semname pre nt con ++ "_" ++ show nr + +-- Gives the name of a type +typeName :: NontermIdent -> Int -> String +typeName nt 0 = "T_" ++ show nt +typeName nt n = "T_" ++ show nt ++ "_" ++ show n + +ntOfVisit :: NontermIdent -> Int -> NontermIdent +ntOfVisit nt 0 = nt +ntOfVisit nt n = Ident (show nt ++ "_" ++ show n) (getPos nt) + +-- Gives the name of a visit function +visitname :: String -> NontermIdent -> Int -> String +visitname pre nt n = pre ++ getName nt ++ "_" ++ show n +{-# LINE 255 "../src-derived/GenerateCode.hs" #-} +-- CGrammar ---------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + errors : Seq Error + output : Program + alternatives: + alternative CGrammar: + child typeSyns : {TypeSyns} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : CNonterminals + child pragmas : {PragmaMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + child multivisit : {Bool} + visit 0: + local options : _ + local aroundMap : _ + local mergeMap : _ + local unfoldSemDom : _ +-} +-- cata +sem_CGrammar :: CGrammar -> + T_CGrammar +sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _nonts _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit ) = + (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CNonterminals _nonts ) _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit ) +-- semantic domain +newtype T_CGrammar = T_CGrammar (Options -> + ( (Seq Error),Program)) +data Inh_CGrammar = Inh_CGrammar {options_Inh_CGrammar :: !(Options)} +data Syn_CGrammar = Syn_CGrammar {errors_Syn_CGrammar :: !((Seq Error)),output_Syn_CGrammar :: !(Program)} +wrap_CGrammar :: T_CGrammar -> + Inh_CGrammar -> + Syn_CGrammar +wrap_CGrammar (T_CGrammar sem ) (Inh_CGrammar _lhsIoptions ) = + (let ( _lhsOerrors,_lhsOoutput) = sem _lhsIoptions + in (Syn_CGrammar _lhsOerrors _lhsOoutput )) +sem_CGrammar_CGrammar :: TypeSyns -> + Derivings -> + (Set NontermIdent) -> + T_CNonterminals -> + PragmaMap -> + ParamMap -> + ContextMap -> + QuantMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + T_CGrammar +sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ = + (T_CGrammar (\ _lhsIoptions -> + (let _nontsOo_sig :: Bool + _nontsOo_cata :: Bool + _nontsOo_sem :: Bool + _nontsOo_newtypes :: Bool + _nontsOo_unbox :: Bool + _nontsOo_case :: Bool + _nontsOo_pretty :: Bool + _nontsOo_rename :: Bool + _nontsOo_strictwrap :: Bool + _nontsOo_splitsems :: Bool + _nontsOo_data :: (Maybe Bool) + _nontsOprefix :: String + _nontsOo_traces :: Bool + _nontsOo_costcentre :: Bool + _nontsOo_linePragmas :: Bool + _nontsOo_monadic :: Bool + _nontsOallPragmas :: PragmaMap + _nontsOparamMap :: ParamMap + _nontsOcontextMap :: ContextMap + _nontsOquantMap :: QuantMap + _nontsOallNts :: (Set NontermIdent) + _nontsOwith_sig :: Bool + _lhsOerrors :: (Seq Error) + _lhsOoutput :: Program + _nontsOtypeSyns :: TypeSyns + _nontsOderivings :: Derivings + _nontsOwrappers :: (Set NontermIdent) + _nontsOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Set Identifier))) + _nontsOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) + _nontsOoptions :: Options + _nontsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _nontsIchunks :: Chunks + _nontsIgathNts :: (Set NontermIdent) + _nontsIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_sig = + ({-# LINE 53 "GenerateCode.ag" #-} + typeSigs _lhsIoptions + {-# LINE 351 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_cata = + ({-# LINE 54 "GenerateCode.ag" #-} + folds _lhsIoptions + {-# LINE 357 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_sem = + ({-# LINE 55 "GenerateCode.ag" #-} + semfuns _lhsIoptions + {-# LINE 363 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_newtypes = + ({-# LINE 56 "GenerateCode.ag" #-} + newtypes _lhsIoptions + {-# LINE 369 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_unbox = + ({-# LINE 57 "GenerateCode.ag" #-} + unbox _lhsIoptions + {-# LINE 375 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_case = + ({-# LINE 58 "GenerateCode.ag" #-} + cases _lhsIoptions + {-# LINE 381 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_pretty = + ({-# LINE 59 "GenerateCode.ag" #-} + attrInfo _lhsIoptions + {-# LINE 387 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_rename = + ({-# LINE 60 "GenerateCode.ag" #-} + rename _lhsIoptions + {-# LINE 393 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_strictwrap = + ({-# LINE 61 "GenerateCode.ag" #-} + strictWrap _lhsIoptions + {-# LINE 399 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_splitsems = + ({-# LINE 62 "GenerateCode.ag" #-} + splitSems _lhsIoptions + {-# LINE 405 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_data = + ({-# LINE 63 "GenerateCode.ag" #-} + if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing + {-# LINE 411 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOprefix = + ({-# LINE 64 "GenerateCode.ag" #-} + prefix _lhsIoptions + {-# LINE 417 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_traces = + ({-# LINE 65 "GenerateCode.ag" #-} + genTraces _lhsIoptions + {-# LINE 423 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_costcentre = + ({-# LINE 66 "GenerateCode.ag" #-} + genCostCentres _lhsIoptions + {-# LINE 429 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_linePragmas = + ({-# LINE 67 "GenerateCode.ag" #-} + genLinePragmas _lhsIoptions + {-# LINE 435 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 53, column 17) + _nontsOo_monadic = + ({-# LINE 68 "GenerateCode.ag" #-} + monadic _lhsIoptions + {-# LINE 441 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 71, column 3) + _options = + ({-# LINE 71 "GenerateCode.ag" #-} + _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && multivisit_ } + {-# LINE 447 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 76, column 15) + _nontsOallPragmas = + ({-# LINE 76 "GenerateCode.ag" #-} + pragmas_ + {-# LINE 453 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 98, column 14) + _nontsOparamMap = + ({-# LINE 98 "GenerateCode.ag" #-} + paramMap_ + {-# LINE 459 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 119, column 7) + _nontsOcontextMap = + ({-# LINE 119 "GenerateCode.ag" #-} + contextMap_ + {-# LINE 465 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 120, column 7) + _nontsOquantMap = + ({-# LINE 120 "GenerateCode.ag" #-} + quantMap_ + {-# LINE 471 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 136, column 7) + _nontsOallNts = + ({-# LINE 136 "GenerateCode.ag" #-} + _nontsIgathNts + {-# LINE 477 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 579, column 34) + _aroundMap = + ({-# LINE 579 "GenerateCode.ag" #-} + aroundsMap_ + {-# LINE 483 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 595, column 34) + _mergeMap = + ({-# LINE 595 "GenerateCode.ag" #-} + mergeMap_ + {-# LINE 489 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 751, column 7) + _unfoldSemDom = + ({-# LINE 751 "GenerateCode.ag" #-} + \nt nr repl -> + let (params, tp) = Map.findWithDefault (error ("No such semantic domain: " ++ show nt)) (nt, nr) _nontsIsemDomUnfoldGath + replMap = Map.fromList (zip params repl) + replace k = Map.findWithDefault ('@':k) k replMap + in evalType replace tp + {-# LINE 499 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 852, column 14) + _nontsOwith_sig = + ({-# LINE 852 "GenerateCode.ag" #-} + typeSigs _lhsIoptions + {-# LINE 505 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 855, column 15) + _lhsOerrors = + ({-# LINE 855 "GenerateCode.ag" #-} + Seq.empty + {-# LINE 511 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 920, column 17) + _lhsOoutput = + ({-# LINE 920 "GenerateCode.ag" #-} + Program _nontsIchunks multivisit_ + {-# LINE 517 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 985, column 14) + _nontsOtypeSyns = + ({-# LINE 985 "GenerateCode.ag" #-} + typeSyns_ + {-# LINE 523 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 985, column 14) + _nontsOderivings = + ({-# LINE 986 "GenerateCode.ag" #-} + derivings_ + {-# LINE 529 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 985, column 14) + _nontsOwrappers = + ({-# LINE 987 "GenerateCode.ag" #-} + wrappers_ + {-# LINE 535 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _nontsOaroundMap = + ({-# LINE 572 "GenerateCode.ag" #-} + _aroundMap + {-# LINE 541 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _nontsOmergeMap = + ({-# LINE 588 "GenerateCode.ag" #-} + _mergeMap + {-# LINE 547 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _nontsOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _options + {-# LINE 553 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _nontsOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _unfoldSemDom + {-# LINE 559 "GenerateCode.hs" #-} + ) + ( _nontsIchunks,_nontsIgathNts,_nontsIsemDomUnfoldGath) = + nonts_ _nontsOallNts _nontsOallPragmas _nontsOaroundMap _nontsOcontextMap _nontsOderivings _nontsOmergeMap _nontsOo_case _nontsOo_cata _nontsOo_costcentre _nontsOo_data _nontsOo_linePragmas _nontsOo_monadic _nontsOo_newtypes _nontsOo_pretty _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_splitsems _nontsOo_strictwrap _nontsOo_traces _nontsOo_unbox _nontsOoptions _nontsOparamMap _nontsOprefix _nontsOquantMap _nontsOtypeSyns _nontsOunfoldSemDom _nontsOwith_sig _nontsOwrappers + in ( _lhsOerrors,_lhsOoutput))) ) +-- CInterface -------------------------------------------------- +{- + visit 0: + inherited attributes: + inh : Attributes + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + syn : Attributes + synthesized attributes: + comments : [String] + semDom : [Decl] + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + wrapDecls : Decls + alternatives: + alternative CInterface: + child seg : CSegments +-} +-- cata +sem_CInterface :: CInterface -> + T_CInterface +sem_CInterface (CInterface _seg ) = + (sem_CInterface_CInterface (sem_CSegments _seg ) ) +-- semantic domain +newtype T_CInterface = T_CInterface (Attributes -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + Attributes -> + ( ([String]),([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls)) +data Inh_CInterface = Inh_CInterface {inh_Inh_CInterface :: !(Attributes),nt_Inh_CInterface :: !(NontermIdent),o_case_Inh_CInterface :: !(Bool),o_cata_Inh_CInterface :: !(Bool),o_costcentre_Inh_CInterface :: !(Bool),o_data_Inh_CInterface :: !((Maybe Bool)),o_linePragmas_Inh_CInterface :: !(Bool),o_monadic_Inh_CInterface :: !(Bool),o_newtypes_Inh_CInterface :: !(Bool),o_pretty_Inh_CInterface :: !(Bool),o_rename_Inh_CInterface :: !(Bool),o_sem_Inh_CInterface :: !(Bool),o_sig_Inh_CInterface :: !(Bool),o_splitsems_Inh_CInterface :: !(Bool),o_strictwrap_Inh_CInterface :: !(Bool),o_traces_Inh_CInterface :: !(Bool),o_unbox_Inh_CInterface :: !(Bool),options_Inh_CInterface :: !(Options),paramMap_Inh_CInterface :: !(ParamMap),prefix_Inh_CInterface :: !(String),syn_Inh_CInterface :: !(Attributes)} +data Syn_CInterface = Syn_CInterface {comments_Syn_CInterface :: !(([String])),semDom_Syn_CInterface :: !(([Decl])),semDomUnfoldGath_Syn_CInterface :: !((Map (NontermIdent, Int) ([String], Code.Type))),wrapDecls_Syn_CInterface :: !(Decls)} +wrap_CInterface :: T_CInterface -> + Inh_CInterface -> + Syn_CInterface +wrap_CInterface (T_CInterface sem ) (Inh_CInterface _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn ) = + (let ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = sem _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn + in (Syn_CInterface _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls )) +sem_CInterface_CInterface :: T_CSegments -> + T_CInterface +sem_CInterface_CInterface (T_CSegments seg_ ) = + (T_CInterface (\ _lhsIinh + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIsyn -> + (let _segOnr :: Int + _lhsOsemDom :: ([Decl]) + _lhsOcomments :: ([String]) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _lhsOwrapDecls :: Decls + _segOinh :: Attributes + _segOnt :: NontermIdent + _segOo_case :: Bool + _segOo_cata :: Bool + _segOo_costcentre :: Bool + _segOo_data :: (Maybe Bool) + _segOo_linePragmas :: Bool + _segOo_monadic :: Bool + _segOo_newtypes :: Bool + _segOo_pretty :: Bool + _segOo_rename :: Bool + _segOo_sem :: Bool + _segOo_sig :: Bool + _segOo_splitsems :: Bool + _segOo_strictwrap :: Bool + _segOo_traces :: Bool + _segOo_unbox :: Bool + _segOoptions :: Options + _segOparamMap :: ParamMap + _segOprefix :: String + _segOsyn :: Attributes + _segIcomments :: ([String]) + _segIisNil :: Bool + _segIsemDom :: ([Decl]) + _segIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _segIwrapDecls :: Decls + -- "GenerateCode.ag"(line 282, column 17) + _segOnr = + ({-# LINE 282 "GenerateCode.ag" #-} + 0 + {-# LINE 693 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 709, column 18) + _lhsOsemDom = + ({-# LINE 709 "GenerateCode.ag" #-} + Comment "semantic domain" : _segIsemDom + {-# LINE 699 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + _segIcomments + {-# LINE 705 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 741, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 741 "GenerateCode.ag" #-} + _segIsemDomUnfoldGath + {-# LINE 711 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 827, column 52) + _lhsOwrapDecls = + ({-# LINE 827 "GenerateCode.ag" #-} + _segIwrapDecls + {-# LINE 717 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 723 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 729 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 735 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 741 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 747 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 753 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 759 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 765 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 771 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 777 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 783 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 789 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 795 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 801 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 807 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 813 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 819 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 825 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 831 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 837 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 843 "GenerateCode.hs" #-} + ) + ( _segIcomments,_segIisNil,_segIsemDom,_segIsemDomUnfoldGath,_segIwrapDecls) = + seg_ _segOinh _segOnr _segOnt _segOo_case _segOo_cata _segOo_costcentre _segOo_data _segOo_linePragmas _segOo_monadic _segOo_newtypes _segOo_pretty _segOo_rename _segOo_sem _segOo_sig _segOo_splitsems _segOo_strictwrap _segOo_traces _segOo_unbox _segOoptions _segOparamMap _segOprefix _segOsyn + in ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))) ) +-- CNonterminal ------------------------------------------------ +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Map NontermIdent (Map ConstructorIdent (Set Identifier)) + contextMap : ContextMap + derivings : Derivings + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + quantMap : QuantMap + typeSyns : TypeSyns + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + wrappers : Set NontermIdent + synthesized attributes: + chunks : Chunks + gathNts : Set NontermIdent + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + alternatives: + alternative CNonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : CProductions + child inter : CInterface + visit 0: + local _tup1 : {(Attributes,Attributes,NontermIdent)} + local _tup2 : {(Attributes,Attributes,NontermIdent)} + local aroundMap : _ + local mergeMap : _ + local semWrapper : _ + local comment : _ + local dataDef : _ + local genCata : _ + local cataFun : _ +-} +-- cata +sem_CNonterminal :: CNonterminal -> + T_CNonterminal +sem_CNonterminal (CNonterminal _nt _params _inh _syn _prods _inter ) = + (sem_CNonterminal_CNonterminal _nt _params _inh _syn (sem_CProductions _prods ) (sem_CInterface _inter ) ) +-- semantic domain +newtype T_CNonterminal = T_CNonterminal ((Set NontermIdent) -> + PragmaMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + ContextMap -> + Derivings -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + QuantMap -> + TypeSyns -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + Bool -> + (Set NontermIdent) -> + ( Chunks,(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type)))) +data Inh_CNonterminal = Inh_CNonterminal {allNts_Inh_CNonterminal :: !((Set NontermIdent)),allPragmas_Inh_CNonterminal :: !(PragmaMap),aroundMap_Inh_CNonterminal :: !((Map NontermIdent (Map ConstructorIdent (Set Identifier)))),contextMap_Inh_CNonterminal :: !(ContextMap),derivings_Inh_CNonterminal :: !(Derivings),mergeMap_Inh_CNonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))))),o_case_Inh_CNonterminal :: !(Bool),o_cata_Inh_CNonterminal :: !(Bool),o_costcentre_Inh_CNonterminal :: !(Bool),o_data_Inh_CNonterminal :: !((Maybe Bool)),o_linePragmas_Inh_CNonterminal :: !(Bool),o_monadic_Inh_CNonterminal :: !(Bool),o_newtypes_Inh_CNonterminal :: !(Bool),o_pretty_Inh_CNonterminal :: !(Bool),o_rename_Inh_CNonterminal :: !(Bool),o_sem_Inh_CNonterminal :: !(Bool),o_sig_Inh_CNonterminal :: !(Bool),o_splitsems_Inh_CNonterminal :: !(Bool),o_strictwrap_Inh_CNonterminal :: !(Bool),o_traces_Inh_CNonterminal :: !(Bool),o_unbox_Inh_CNonterminal :: !(Bool),options_Inh_CNonterminal :: !(Options),paramMap_Inh_CNonterminal :: !(ParamMap),prefix_Inh_CNonterminal :: !(String),quantMap_Inh_CNonterminal :: !(QuantMap),typeSyns_Inh_CNonterminal :: !(TypeSyns),unfoldSemDom_Inh_CNonterminal :: !((NontermIdent -> Int -> [String] -> Code.Type)),with_sig_Inh_CNonterminal :: !(Bool),wrappers_Inh_CNonterminal :: !((Set NontermIdent))} +data Syn_CNonterminal = Syn_CNonterminal {chunks_Syn_CNonterminal :: !(Chunks),gathNts_Syn_CNonterminal :: !((Set NontermIdent)),semDomUnfoldGath_Syn_CNonterminal :: !((Map (NontermIdent, Int) ([String], Code.Type)))} +wrap_CNonterminal :: T_CNonterminal -> + Inh_CNonterminal -> + Syn_CNonterminal +wrap_CNonterminal (T_CNonterminal sem ) (Inh_CNonterminal _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers ) = + (let ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers + in (Syn_CNonterminal _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath )) +sem_CNonterminal_CNonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_CProductions -> + T_CInterface -> + T_CNonterminal +sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_ ) (T_CInterface inter_ ) = + (T_CNonterminal (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIderivings + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsItypeSyns + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let __tup1 :: ((Attributes,Attributes,NontermIdent)) + _interOinh :: Attributes + _interOsyn :: Attributes + _interOnt :: NontermIdent + __tup2 :: ((Attributes,Attributes,NontermIdent)) + _prodsOinh :: Attributes + _prodsOsyn :: Attributes + _prodsOnt :: NontermIdent + _lhsOgathNts :: (Set NontermIdent) + _lhsOchunks :: Chunks + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _prodsOallNts :: (Set NontermIdent) + _prodsOallPragmas :: PragmaMap + _prodsOaroundMap :: (Map ConstructorIdent (Set Identifier)) + _prodsOcontextMap :: ContextMap + _prodsOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + _prodsOo_case :: Bool + _prodsOo_cata :: Bool + _prodsOo_costcentre :: Bool + _prodsOo_data :: (Maybe Bool) + _prodsOo_linePragmas :: Bool + _prodsOo_monadic :: Bool + _prodsOo_newtypes :: Bool + _prodsOo_pretty :: Bool + _prodsOo_rename :: Bool + _prodsOo_sem :: Bool + _prodsOo_sig :: Bool + _prodsOo_splitsems :: Bool + _prodsOo_strictwrap :: Bool + _prodsOo_traces :: Bool + _prodsOo_unbox :: Bool + _prodsOoptions :: Options + _prodsOparamMap :: ParamMap + _prodsOprefix :: String + _prodsOquantMap :: QuantMap + _prodsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _prodsOwith_sig :: Bool + _interOo_case :: Bool + _interOo_cata :: Bool + _interOo_costcentre :: Bool + _interOo_data :: (Maybe Bool) + _interOo_linePragmas :: Bool + _interOo_monadic :: Bool + _interOo_newtypes :: Bool + _interOo_pretty :: Bool + _interOo_rename :: Bool + _interOo_sem :: Bool + _interOo_sig :: Bool + _interOo_splitsems :: Bool + _interOo_strictwrap :: Bool + _interOo_traces :: Bool + _interOo_unbox :: Bool + _interOoptions :: Options + _interOparamMap :: ParamMap + _interOprefix :: String + _prodsIcataAlts :: Decls + _prodsIcomments :: ([String]) + _prodsIdataAlts :: DataAlts + _prodsIdecls :: Decls + _prodsIsemNames :: ([String]) + _interIcomments :: ([String]) + _interIsemDom :: ([Decl]) + _interIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _interIwrapDecls :: Decls + -- "GenerateCode.ag"(line 86, column 26) + __tup1 = + ({-# LINE 86 "GenerateCode.ag" #-} + (inh_,syn_,nt_) + {-# LINE 1053 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 86, column 26) + (_interOinh,_,_) = + ({-# LINE 86 "GenerateCode.ag" #-} + __tup1 + {-# LINE 1059 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 86, column 26) + (_,_interOsyn,_) = + ({-# LINE 86 "GenerateCode.ag" #-} + __tup1 + {-# LINE 1065 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 86, column 26) + (_,_,_interOnt) = + ({-# LINE 86 "GenerateCode.ag" #-} + __tup1 + {-# LINE 1071 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 87, column 25) + __tup2 = + ({-# LINE 87 "GenerateCode.ag" #-} + (inh_,syn_,nt_) + {-# LINE 1077 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 87, column 25) + (_prodsOinh,_,_) = + ({-# LINE 87 "GenerateCode.ag" #-} + __tup2 + {-# LINE 1083 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 87, column 25) + (_,_prodsOsyn,_) = + ({-# LINE 87 "GenerateCode.ag" #-} + __tup2 + {-# LINE 1089 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 87, column 25) + (_,_,_prodsOnt) = + ({-# LINE 87 "GenerateCode.ag" #-} + __tup2 + {-# LINE 1095 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 142, column 7) + _lhsOgathNts = + ({-# LINE 142 "GenerateCode.ag" #-} + Set.singleton nt_ + {-# LINE 1101 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 580, column 34) + _aroundMap = + ({-# LINE 580 "GenerateCode.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundMap + {-# LINE 1107 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 596, column 34) + _mergeMap = + ({-# LINE 596 "GenerateCode.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergeMap + {-# LINE 1113 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 801, column 18) + _semWrapper = + ({-# LINE 801 "GenerateCode.ag" #-} + let params' = map getName params_ + inhAttrs = Map.toList inh_ + synAttrs = Map.toList syn_ + inhVars = [ SimpleExpr (attrname True _LHS a) | (a,_) <- inhAttrs ] + synVars = [ SimpleExpr (attrname False _LHS a) | (a,_) <- synAttrs ] + var = "sem" + wrapNT = "wrap" ++ "_" ++ getName nt_ + inhNT = "Inh" ++ "_" ++ getName nt_ + synNT = "Syn" ++ "_" ++ getName nt_ + varPat = if _lhsIo_newtypes + then App (sdtype nt_) [SimpleExpr var] + else SimpleExpr var + evalTp | null params' = id + | otherwise = idEvalType + appParams nm = TypeApp (SimpleType nm) (map SimpleType params') + typeSig = TSig wrapNT (evalTp $ appParams (sdtype nt_) `Arr` (appParams inhNT `Arr` appParams synNT)) + mkstrict = Named _lhsIo_strictwrap + mkdata n attrs = Data n params' [Record n [mkstrict (getName f++"_"++n) $ evalTp $ typeToCodeType (Just nt_) params' t | (f,t) <- attrs]] False [] + datas = [mkdata inhNT inhAttrs, mkdata synNT synAttrs] + in datas ++ [ typeSig + , Decl (Fun wrapNT [varPat, App inhNT inhVars]) + (Let _interIwrapDecls (App synNT synVars)) + Set.empty Set.empty + ] + {-# LINE 1142 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 862, column 18) + _comment = + ({-# LINE 862 "GenerateCode.ag" #-} + Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) ) + {-# LINE 1148 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 923, column 19) + _lhsOchunks = + ({-# LINE 923 "GenerateCode.ag" #-} + [ Chunk (getName nt_) + (Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-')) + (if _lhsIo_pretty then [_comment ] else []) + (if isJust _lhsIo_data then [_dataDef ] else []) + (if _lhsIo_cata && _genCata then _cataFun else []) + (if _lhsIo_sig then _interIsemDom else []) + (if nt_ `Set.member` _lhsIwrappers then _semWrapper else []) + (if _lhsIo_sem then _prodsIdecls else []) + (if _lhsIo_sem then _prodsIsemNames else []) + ] + {-# LINE 1163 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 990, column 18) + _dataDef = + ({-# LINE 990 "GenerateCode.ag" #-} + let params' = map getName params_ + typeSyn tp = let theType = + case tp of + CommonTypes.Maybe t -> TMaybe $ typeToCodeType (Just nt_) params' t + CommonTypes.Either t1 t2 -> TEither (typeToCodeType (Just nt_) params' t1) (typeToCodeType (Just nt_) params' t2) + CommonTypes.Map t1 t2 -> TMap (typeToCodeType (Just nt_) params' t1) (typeToCodeType (Just nt_) params' t2) + CommonTypes.IntMap t -> TIntMap $ typeToCodeType (Just nt_) params' t + CommonTypes.List t -> Code.List $ typeToCodeType (Just nt_) params' t + CommonTypes.Tuple ts -> Code.TupleType [typeToCodeType (Just nt_) params' t + | (_,t) <- ts + ] + in Code.Type (getName nt_) params' (idEvalType theType) + derivings = maybe [] (map getName . Set.toList) (Map.lookup nt_ _lhsIderivings) + dataDef = Data (getName nt_) (map getName params_) _prodsIdataAlts (maybe False id _lhsIo_data) derivings + in maybe dataDef typeSyn $ lookup nt_ _lhsItypeSyns + {-# LINE 1183 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 1022, column 18) + _genCata = + ({-# LINE 1022 "GenerateCode.ag" #-} + not (nt_ `Set.member` nocatas _lhsIoptions) + {-# LINE 1189 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 1023, column 18) + _cataFun = + ({-# LINE 1023 "GenerateCode.ag" #-} + let appParams nm = TypeApp (SimpleType nm) (map SimpleType (map getName params_)) + evalTp | null params_ = id + | otherwise = idEvalType + tSig = TSig (cataname _lhsIprefix nt_) + (appQuant _lhsIquantMap nt_ $ appContext _lhsIcontextMap nt_ $ evalTp $ appParams (getName nt_) `Arr` appParams (sdtype nt_)) + special typ = case typ of + CommonTypes.List tp -> + let cons = SimpleExpr (semname _lhsIprefix nt_ (identifier "Cons")) + nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" )) + arg = SimpleExpr "list" + rarg = case tp of + NT t _ -> let t' = maybe t id (deforestedNt t) + in SimpleExpr ("(Prelude.map " ++ (cataname _lhsIprefix t') ++ " list)") + _ -> arg + lhs = Fun (cataname _lhsIprefix nt_) [arg] + rhs = (App "Prelude.foldr" [cons,nil,rarg]) + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.Maybe tp -> + let just = semname _lhsIprefix nt_ (identifier "Just") + nothing = semname _lhsIprefix nt_ (identifier "Nothing" ) + arg = SimpleExpr "x" + rarg = case tp of + NT t _ -> let t' = maybe t id (deforestedNt t) + in App (cataname _lhsIprefix t') [arg] + _ -> arg + lhs a = Fun (cataname _lhsIprefix nt_) [a] + in [Decl (lhs (App "Prelude.Just" [arg])) (App just [rarg]) Set.empty Set.empty + ,Decl (lhs (SimpleExpr "Prelude.Nothing")) (SimpleExpr nothing) Set.empty Set.empty + ] + CommonTypes.Either tp1 tp2 -> + let left = semname _lhsIprefix nt_ (identifier "Left") + right = semname _lhsIprefix nt_ (identifier "Right" ) + arg = SimpleExpr "x" + rarg0 = case tp1 of + NT t _ -> let t' = maybe t id (deforestedNt t) + in App (cataname _lhsIprefix t') [arg] + _ -> arg + rarg1 = case tp2 of + NT t _ -> let t' = maybe t id (deforestedNt t) + in App (cataname _lhsIprefix t') [arg] + _ -> arg + lhs a = Fun (cataname _lhsIprefix nt_) [a] + in [Decl (lhs (App "Prelude.Left" [arg])) (App left [rarg0]) Set.empty Set.empty + ,Decl (lhs (App "Prelude.Right" [arg])) (App right [rarg1]) Set.empty Set.empty + ] + CommonTypes.Map _ tp -> + let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) + nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil")) + arg = SimpleExpr "m" + rarg = case tp of + NT t _ -> let t' = maybe t id (deforestedNt t) + in App "Data.Map.map" [SimpleExpr $ cataname _lhsIprefix t', arg] + _ -> arg + lhs = Fun (cataname _lhsIprefix nt_) [arg] + rhs = App "Data.Map.foldrWithKey" [entry,nil,rarg] + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.IntMap tp -> + let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) + nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil")) + arg = SimpleExpr "m" + rarg = case tp of + NT t _ -> let t' = maybe t id (deforestedNt t) + in App "Data.IntMap.map" [SimpleExpr $ cataname _lhsIprefix t', arg] + _ -> arg + lhs = Fun (cataname _lhsIprefix nt_) [arg] + rhs = App "Data.IntMap.foldWithKey" [entry,nil,rarg] + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.Tuple tps -> + let con = semname _lhsIprefix nt_ (identifier "Tuple") + tps' = [ (SimpleExpr (getName x),y) | (x,y) <- tps] + rargs = map rarg tps' + rarg (n, tp) = case tp of + NT t _ -> let t' = maybe t id (deforestedNt t) + in App (cataname _lhsIprefix t') [n] + _ -> n + lhs = Fun (cataname _lhsIprefix nt_) [TupleExpr (map fst tps')] + rhs = App con rargs + in [Decl lhs rhs Set.empty Set.empty] + in Comment "cata" : + (if _lhsIo_sig then [tSig] else []) ++ + maybe _prodsIcataAlts special (lookup nt_ _lhsItypeSyns) + {-# LINE 1275 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 741, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 741 "GenerateCode.ag" #-} + _interIsemDomUnfoldGath + {-# LINE 1281 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 1287 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOallPragmas = + ({-# LINE 73 "GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 1293 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _prodsOaroundMap = + ({-# LINE 575 "GenerateCode.ag" #-} + _aroundMap + {-# LINE 1299 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOcontextMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 1305 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _prodsOmergeMap = + ({-# LINE 591 "GenerateCode.ag" #-} + _mergeMap + {-# LINE 1311 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 1317 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 1323 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 1329 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 1335 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 1341 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 1347 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 1353 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 1359 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 1365 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 1371 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 1377 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 1383 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 1389 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 1395 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 1401 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 1407 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 1413 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 1419 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOquantMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 1425 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 1431 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOwith_sig = + ({-# LINE 849 "GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 1437 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 1443 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 1449 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 1455 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 1461 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 1467 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 1473 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 1479 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 1485 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 1491 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 1497 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 1503 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 1509 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 1515 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 1521 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 1527 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 1533 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 1539 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 1545 "GenerateCode.hs" #-} + ) + ( _prodsIcataAlts,_prodsIcomments,_prodsIdataAlts,_prodsIdecls,_prodsIsemNames) = + prods_ _prodsOallNts _prodsOallPragmas _prodsOaroundMap _prodsOcontextMap _prodsOinh _prodsOmergeMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_costcentre _prodsOo_data _prodsOo_linePragmas _prodsOo_monadic _prodsOo_newtypes _prodsOo_pretty _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_splitsems _prodsOo_strictwrap _prodsOo_traces _prodsOo_unbox _prodsOoptions _prodsOparamMap _prodsOprefix _prodsOquantMap _prodsOsyn _prodsOunfoldSemDom _prodsOwith_sig + ( _interIcomments,_interIsemDom,_interIsemDomUnfoldGath,_interIwrapDecls) = + inter_ _interOinh _interOnt _interOo_case _interOo_cata _interOo_costcentre _interOo_data _interOo_linePragmas _interOo_monadic _interOo_newtypes _interOo_pretty _interOo_rename _interOo_sem _interOo_sig _interOo_splitsems _interOo_strictwrap _interOo_traces _interOo_unbox _interOoptions _interOparamMap _interOprefix _interOsyn + in ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath))) ) +-- CNonterminals ----------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Map NontermIdent (Map ConstructorIdent (Set Identifier)) + contextMap : ContextMap + derivings : Derivings + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + quantMap : QuantMap + typeSyns : TypeSyns + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + wrappers : Set NontermIdent + synthesized attributes: + chunks : Chunks + gathNts : Set NontermIdent + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + alternatives: + alternative Cons: + child hd : CNonterminal + child tl : CNonterminals + alternative Nil: +-} +-- cata +sem_CNonterminals :: CNonterminals -> + T_CNonterminals +sem_CNonterminals list = + (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list) ) +-- semantic domain +newtype T_CNonterminals = T_CNonterminals ((Set NontermIdent) -> + PragmaMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + ContextMap -> + Derivings -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + QuantMap -> + TypeSyns -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + Bool -> + (Set NontermIdent) -> + ( Chunks,(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type)))) +data Inh_CNonterminals = Inh_CNonterminals {allNts_Inh_CNonterminals :: !((Set NontermIdent)),allPragmas_Inh_CNonterminals :: !(PragmaMap),aroundMap_Inh_CNonterminals :: !((Map NontermIdent (Map ConstructorIdent (Set Identifier)))),contextMap_Inh_CNonterminals :: !(ContextMap),derivings_Inh_CNonterminals :: !(Derivings),mergeMap_Inh_CNonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))))),o_case_Inh_CNonterminals :: !(Bool),o_cata_Inh_CNonterminals :: !(Bool),o_costcentre_Inh_CNonterminals :: !(Bool),o_data_Inh_CNonterminals :: !((Maybe Bool)),o_linePragmas_Inh_CNonterminals :: !(Bool),o_monadic_Inh_CNonterminals :: !(Bool),o_newtypes_Inh_CNonterminals :: !(Bool),o_pretty_Inh_CNonterminals :: !(Bool),o_rename_Inh_CNonterminals :: !(Bool),o_sem_Inh_CNonterminals :: !(Bool),o_sig_Inh_CNonterminals :: !(Bool),o_splitsems_Inh_CNonterminals :: !(Bool),o_strictwrap_Inh_CNonterminals :: !(Bool),o_traces_Inh_CNonterminals :: !(Bool),o_unbox_Inh_CNonterminals :: !(Bool),options_Inh_CNonterminals :: !(Options),paramMap_Inh_CNonterminals :: !(ParamMap),prefix_Inh_CNonterminals :: !(String),quantMap_Inh_CNonterminals :: !(QuantMap),typeSyns_Inh_CNonterminals :: !(TypeSyns),unfoldSemDom_Inh_CNonterminals :: !((NontermIdent -> Int -> [String] -> Code.Type)),with_sig_Inh_CNonterminals :: !(Bool),wrappers_Inh_CNonterminals :: !((Set NontermIdent))} +data Syn_CNonterminals = Syn_CNonterminals {chunks_Syn_CNonterminals :: !(Chunks),gathNts_Syn_CNonterminals :: !((Set NontermIdent)),semDomUnfoldGath_Syn_CNonterminals :: !((Map (NontermIdent, Int) ([String], Code.Type)))} +wrap_CNonterminals :: T_CNonterminals -> + Inh_CNonterminals -> + Syn_CNonterminals +wrap_CNonterminals (T_CNonterminals sem ) (Inh_CNonterminals _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers ) = + (let ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers + in (Syn_CNonterminals _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath )) +sem_CNonterminals_Cons :: T_CNonterminal -> + T_CNonterminals -> + T_CNonterminals +sem_CNonterminals_Cons (T_CNonterminal hd_ ) (T_CNonterminals tl_ ) = + (T_CNonterminals (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIderivings + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsItypeSyns + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let _lhsOchunks :: Chunks + _lhsOgathNts :: (Set NontermIdent) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _hdOallNts :: (Set NontermIdent) + _hdOallPragmas :: PragmaMap + _hdOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Set Identifier))) + _hdOcontextMap :: ContextMap + _hdOderivings :: Derivings + _hdOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOquantMap :: QuantMap + _hdOtypeSyns :: TypeSyns + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _hdOwith_sig :: Bool + _hdOwrappers :: (Set NontermIdent) + _tlOallNts :: (Set NontermIdent) + _tlOallPragmas :: PragmaMap + _tlOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Set Identifier))) + _tlOcontextMap :: ContextMap + _tlOderivings :: Derivings + _tlOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOquantMap :: QuantMap + _tlOtypeSyns :: TypeSyns + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _tlOwith_sig :: Bool + _tlOwrappers :: (Set NontermIdent) + _hdIchunks :: Chunks + _hdIgathNts :: (Set NontermIdent) + _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _tlIchunks :: Chunks + _tlIgathNts :: (Set NontermIdent) + _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + -- use rule "GenerateCode.ag"(line 915, column 49) + _lhsOchunks = + ({-# LINE 915 "GenerateCode.ag" #-} + _hdIchunks ++ _tlIchunks + {-# LINE 1743 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 138, column 47) + _lhsOgathNts = + ({-# LINE 138 "GenerateCode.ag" #-} + _hdIgathNts `Set.union` _tlIgathNts + {-# LINE 1749 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 741, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 741 "GenerateCode.ag" #-} + _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath + {-# LINE 1755 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 1761 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallPragmas = + ({-# LINE 73 "GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 1767 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 572 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 1773 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcontextMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 1779 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOderivings = + ({-# LINE 983 "GenerateCode.ag" #-} + _lhsIderivings + {-# LINE 1785 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 588 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 1791 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 1797 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 1803 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 1809 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 1815 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 1821 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 1827 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 1833 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 1839 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 1845 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 1851 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 1857 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 1863 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 1869 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 1875 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 1881 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 1887 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 1893 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 1899 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOquantMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 1905 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOtypeSyns = + ({-# LINE 983 "GenerateCode.ag" #-} + _lhsItypeSyns + {-# LINE 1911 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 1917 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwith_sig = + ({-# LINE 849 "GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 1923 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwrappers = + ({-# LINE 983 "GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 1929 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 1935 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallPragmas = + ({-# LINE 73 "GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 1941 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 572 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 1947 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcontextMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 1953 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOderivings = + ({-# LINE 983 "GenerateCode.ag" #-} + _lhsIderivings + {-# LINE 1959 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 588 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 1965 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 1971 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 1977 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 1983 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 1989 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 1995 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 2001 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 2007 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 2013 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 2019 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 2025 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 2031 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 2037 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 2043 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 2049 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 2055 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 2061 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 2067 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 2073 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOquantMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 2079 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOtypeSyns = + ({-# LINE 983 "GenerateCode.ag" #-} + _lhsItypeSyns + {-# LINE 2085 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 2091 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwith_sig = + ({-# LINE 849 "GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 2097 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwrappers = + ({-# LINE 983 "GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 2103 "GenerateCode.hs" #-} + ) + ( _hdIchunks,_hdIgathNts,_hdIsemDomUnfoldGath) = + hd_ _hdOallNts _hdOallPragmas _hdOaroundMap _hdOcontextMap _hdOderivings _hdOmergeMap _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOquantMap _hdOtypeSyns _hdOunfoldSemDom _hdOwith_sig _hdOwrappers + ( _tlIchunks,_tlIgathNts,_tlIsemDomUnfoldGath) = + tl_ _tlOallNts _tlOallPragmas _tlOaroundMap _tlOcontextMap _tlOderivings _tlOmergeMap _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOquantMap _tlOtypeSyns _tlOunfoldSemDom _tlOwith_sig _tlOwrappers + in ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath))) ) +sem_CNonterminals_Nil :: T_CNonterminals +sem_CNonterminals_Nil = + (T_CNonterminals (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIderivings + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsItypeSyns + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let _lhsOchunks :: Chunks + _lhsOgathNts :: (Set NontermIdent) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + -- use rule "GenerateCode.ag"(line 915, column 49) + _lhsOchunks = + ({-# LINE 915 "GenerateCode.ag" #-} + [] + {-# LINE 2148 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 138, column 47) + _lhsOgathNts = + ({-# LINE 138 "GenerateCode.ag" #-} + Set.empty + {-# LINE 2154 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 741, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 741 "GenerateCode.ag" #-} + Map.empty + {-# LINE 2160 "GenerateCode.hs" #-} + ) + in ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath))) ) +-- CProduction ------------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Map ConstructorIdent (Set Identifier) + contextMap : ContextMap + inh : Attributes + mergeMap : Map ConstructorIdent (Map Identifier (Identifier, [Identifier])) + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + quantMap : QuantMap + syn : Attributes + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + synthesized attributes: + cataAlt : Decl + comments : [String] + dataAlt : DataAlt + decls : Decls + semNames : [String] + alternatives: + alternative CProduction: + child con : {ConstructorIdent} + child visits : CVisits + child children : {[(Identifier,Type,Maybe (Maybe Type))]} + child terminals : {[Identifier]} + visit 0: + local paramInstMap : _ + local aroundMap : _ + local mergeMap : _ + local firstOrderChildren : _ + local params : _ +-} +-- cata +sem_CProduction :: CProduction -> + T_CProduction +sem_CProduction (CProduction _con _visits _children _terminals ) = + (sem_CProduction_CProduction _con (sem_CVisits _visits ) _children _terminals ) +-- semantic domain +newtype T_CProduction = T_CProduction ((Set NontermIdent) -> + PragmaMap -> + (Map ConstructorIdent (Set Identifier)) -> + ContextMap -> + Attributes -> + (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + QuantMap -> + Attributes -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + Bool -> + ( Decl,([String]),DataAlt,Decls,([String]))) +data Inh_CProduction = Inh_CProduction {allNts_Inh_CProduction :: !((Set NontermIdent)),allPragmas_Inh_CProduction :: !(PragmaMap),aroundMap_Inh_CProduction :: !((Map ConstructorIdent (Set Identifier))),contextMap_Inh_CProduction :: !(ContextMap),inh_Inh_CProduction :: !(Attributes),mergeMap_Inh_CProduction :: !((Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))),nt_Inh_CProduction :: !(NontermIdent),o_case_Inh_CProduction :: !(Bool),o_cata_Inh_CProduction :: !(Bool),o_costcentre_Inh_CProduction :: !(Bool),o_data_Inh_CProduction :: !((Maybe Bool)),o_linePragmas_Inh_CProduction :: !(Bool),o_monadic_Inh_CProduction :: !(Bool),o_newtypes_Inh_CProduction :: !(Bool),o_pretty_Inh_CProduction :: !(Bool),o_rename_Inh_CProduction :: !(Bool),o_sem_Inh_CProduction :: !(Bool),o_sig_Inh_CProduction :: !(Bool),o_splitsems_Inh_CProduction :: !(Bool),o_strictwrap_Inh_CProduction :: !(Bool),o_traces_Inh_CProduction :: !(Bool),o_unbox_Inh_CProduction :: !(Bool),options_Inh_CProduction :: !(Options),paramMap_Inh_CProduction :: !(ParamMap),prefix_Inh_CProduction :: !(String),quantMap_Inh_CProduction :: !(QuantMap),syn_Inh_CProduction :: !(Attributes),unfoldSemDom_Inh_CProduction :: !((NontermIdent -> Int -> [String] -> Code.Type)),with_sig_Inh_CProduction :: !(Bool)} +data Syn_CProduction = Syn_CProduction {cataAlt_Syn_CProduction :: !(Decl),comments_Syn_CProduction :: !(([String])),dataAlt_Syn_CProduction :: !(DataAlt),decls_Syn_CProduction :: !(Decls),semNames_Syn_CProduction :: !(([String]))} +wrap_CProduction :: T_CProduction -> + Inh_CProduction -> + Syn_CProduction +wrap_CProduction (T_CProduction sem ) (Inh_CProduction _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig ) = + (let ( _lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOsemNames) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig + in (Syn_CProduction _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOsemNames )) +sem_CProduction_CProduction :: ConstructorIdent -> + T_CVisits -> + ([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + T_CProduction +sem_CProduction_CProduction con_ (T_CVisits visits_ ) children_ terminals_ = + (T_CProduction (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIunfoldSemDom + _lhsIwith_sig -> + (let _visitsOcon :: ConstructorIdent + _visitsOterminals :: ([Identifier]) + _visitsOvisitedSet :: (Set Identifier) + _visitsOnr :: Int + _visitsOchildren :: ([(Identifier,Type, Maybe (Maybe Type))]) + _visitsOinstVisitNrs :: (Map Identifier Int) + _lhsOcomments :: ([String]) + _lhsOdataAlt :: DataAlt + _lhsOcataAlt :: Decl + _lhsOdecls :: Decls + _lhsOsemNames :: ([String]) + _visitsOallNts :: (Set NontermIdent) + _visitsOallPragmas :: PragmaMap + _visitsOaroundMap :: (Set Identifier) + _visitsOcontextMap :: ContextMap + _visitsOinh :: Attributes + _visitsOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _visitsOnt :: NontermIdent + _visitsOo_case :: Bool + _visitsOo_cata :: Bool + _visitsOo_costcentre :: Bool + _visitsOo_data :: (Maybe Bool) + _visitsOo_linePragmas :: Bool + _visitsOo_monadic :: Bool + _visitsOo_newtypes :: Bool + _visitsOo_pretty :: Bool + _visitsOo_rename :: Bool + _visitsOo_sem :: Bool + _visitsOo_sig :: Bool + _visitsOo_splitsems :: Bool + _visitsOo_strictwrap :: Bool + _visitsOo_traces :: Bool + _visitsOo_unbox :: Bool + _visitsOoptions :: Options + _visitsOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _visitsOparamMap :: ParamMap + _visitsOprefix :: String + _visitsOquantMap :: QuantMap + _visitsOsyn :: Attributes + _visitsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _visitsOwith_sig :: Bool + _visitsIcomments :: ([String]) + _visitsIdecls :: Decls + _visitsIgatherInstVisitNrs :: (Map Identifier Int) + _visitsIintra :: Exprs + _visitsIintraVars :: (Set String) + _visitsIisNil :: Bool + _visitsIsemNames :: ([String]) + _visitsIvisitedSet :: (Set Identifier) + -- "GenerateCode.ag"(line 92, column 19) + _visitsOcon = + ({-# LINE 92 "GenerateCode.ag" #-} + con_ + {-# LINE 2347 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 93, column 20) + _visitsOterminals = + ({-# LINE 93 "GenerateCode.ag" #-} + terminals_ + {-# LINE 2353 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 105, column 7) + _paramInstMap = + ({-# LINE 105 "GenerateCode.ag" #-} + Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- children_, let tps = map cleanupArg $ nontermArgs tp, not (null tps) ] + {-# LINE 2359 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 146, column 32) + _visitsOvisitedSet = + ({-# LINE 146 "GenerateCode.ag" #-} + Set.empty + {-# LINE 2365 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 278, column 18) + _visitsOnr = + ({-# LINE 278 "GenerateCode.ag" #-} + 0 + {-# LINE 2371 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 419, column 18) + _visitsOchildren = + ({-# LINE 419 "GenerateCode.ag" #-} + children_ + {-# LINE 2377 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 561, column 7) + _visitsOinstVisitNrs = + ({-# LINE 561 "GenerateCode.ag" #-} + _visitsIgatherInstVisitNrs + {-# LINE 2383 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 581, column 34) + _aroundMap = + ({-# LINE 581 "GenerateCode.ag" #-} + Map.findWithDefault Set.empty con_ _lhsIaroundMap + {-# LINE 2389 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 597, column 34) + _mergeMap = + ({-# LINE 597 "GenerateCode.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergeMap + {-# LINE 2395 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 877, column 18) + _firstOrderChildren = + ({-# LINE 877 "GenerateCode.ag" #-} + [ (nm,fromJust mb,virt) | (nm,tp,virt) <- children_, let mb = isFirstOrder virt tp, isJust mb ] + {-# LINE 2401 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 878, column 18) + _lhsOcomments = + ({-# LINE 878 "GenerateCode.ag" #-} + ("alternative " ++ getName con_ ++ ":") + : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren + ++ _visitsIcomments + ) + {-# LINE 2410 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 1014, column 17) + _params = + ({-# LINE 1014 "GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap + {-# LINE 2416 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 1015, column 17) + _lhsOdataAlt = + ({-# LINE 1015 "GenerateCode.ag" #-} + DataAlt (conname _lhsIo_rename _lhsInt con_) (map (\(_,t,_) -> typeToCodeType (Just _lhsInt) _params t) _firstOrderChildren ) + {-# LINE 2422 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 1115, column 17) + _lhsOcataAlt = + ({-# LINE 1115 "GenerateCode.ag" #-} + let lhs = Fun (cataname _lhsIprefix _lhsInt) [lhs_pat] + lhs_pat = App (conname _lhsIo_rename _lhsInt con_) + (map (\(n,_,_) -> SimpleExpr $ locname $ n) _firstOrderChildren ) + rhs = App (semname _lhsIprefix _lhsInt con_) + (map argument _firstOrderChildren ) + argument (nm,NT tp _,_) = let tp' = maybe tp id (deforestedNt tp) + in App (cataname _lhsIprefix tp') + [SimpleExpr (locname nm)] + argument (nm, _,_) = SimpleExpr (locname nm) + in Decl lhs rhs Set.empty Set.empty + {-# LINE 2437 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 916, column 44) + _lhsOdecls = + ({-# LINE 916 "GenerateCode.ag" #-} + _visitsIdecls + {-# LINE 2443 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 1131, column 61) + _lhsOsemNames = + ({-# LINE 1131 "GenerateCode.ag" #-} + _visitsIsemNames + {-# LINE 2449 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 2455 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOallPragmas = + ({-# LINE 73 "GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 2461 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _visitsOaroundMap = + ({-# LINE 577 "GenerateCode.ag" #-} + _aroundMap + {-# LINE 2467 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOcontextMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 2473 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 2479 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _visitsOmergeMap = + ({-# LINE 593 "GenerateCode.ag" #-} + _mergeMap + {-# LINE 2485 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 2491 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 2497 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 2503 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 2509 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 2515 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 2521 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 2527 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 2533 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 2539 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 2545 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 2551 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 2557 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 2563 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 2569 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 2575 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 2581 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 2587 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _visitsOparamInstMap = + ({-# LINE 101 "GenerateCode.ag" #-} + _paramInstMap + {-# LINE 2593 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 2599 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 2605 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOquantMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 2611 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 2617 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 2623 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOwith_sig = + ({-# LINE 849 "GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 2629 "GenerateCode.hs" #-} + ) + ( _visitsIcomments,_visitsIdecls,_visitsIgatherInstVisitNrs,_visitsIintra,_visitsIintraVars,_visitsIisNil,_visitsIsemNames,_visitsIvisitedSet) = + visits_ _visitsOallNts _visitsOallPragmas _visitsOaroundMap _visitsOchildren _visitsOcon _visitsOcontextMap _visitsOinh _visitsOinstVisitNrs _visitsOmergeMap _visitsOnr _visitsOnt _visitsOo_case _visitsOo_cata _visitsOo_costcentre _visitsOo_data _visitsOo_linePragmas _visitsOo_monadic _visitsOo_newtypes _visitsOo_pretty _visitsOo_rename _visitsOo_sem _visitsOo_sig _visitsOo_splitsems _visitsOo_strictwrap _visitsOo_traces _visitsOo_unbox _visitsOoptions _visitsOparamInstMap _visitsOparamMap _visitsOprefix _visitsOquantMap _visitsOsyn _visitsOterminals _visitsOunfoldSemDom _visitsOvisitedSet _visitsOwith_sig + in ( _lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOsemNames))) ) +-- CProductions ------------------------------------------------ +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Map ConstructorIdent (Set Identifier) + contextMap : ContextMap + inh : Attributes + mergeMap : Map ConstructorIdent (Map Identifier (Identifier, [Identifier])) + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + quantMap : QuantMap + syn : Attributes + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + synthesized attributes: + cataAlts : Decls + comments : [String] + dataAlts : DataAlts + decls : Decls + semNames : [String] + alternatives: + alternative Cons: + child hd : CProduction + child tl : CProductions + alternative Nil: +-} +-- cata +sem_CProductions :: CProductions -> + T_CProductions +sem_CProductions list = + (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) ) +-- semantic domain +newtype T_CProductions = T_CProductions ((Set NontermIdent) -> + PragmaMap -> + (Map ConstructorIdent (Set Identifier)) -> + ContextMap -> + Attributes -> + (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + QuantMap -> + Attributes -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + Bool -> + ( Decls,([String]),DataAlts,Decls,([String]))) +data Inh_CProductions = Inh_CProductions {allNts_Inh_CProductions :: !((Set NontermIdent)),allPragmas_Inh_CProductions :: !(PragmaMap),aroundMap_Inh_CProductions :: !((Map ConstructorIdent (Set Identifier))),contextMap_Inh_CProductions :: !(ContextMap),inh_Inh_CProductions :: !(Attributes),mergeMap_Inh_CProductions :: !((Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))),nt_Inh_CProductions :: !(NontermIdent),o_case_Inh_CProductions :: !(Bool),o_cata_Inh_CProductions :: !(Bool),o_costcentre_Inh_CProductions :: !(Bool),o_data_Inh_CProductions :: !((Maybe Bool)),o_linePragmas_Inh_CProductions :: !(Bool),o_monadic_Inh_CProductions :: !(Bool),o_newtypes_Inh_CProductions :: !(Bool),o_pretty_Inh_CProductions :: !(Bool),o_rename_Inh_CProductions :: !(Bool),o_sem_Inh_CProductions :: !(Bool),o_sig_Inh_CProductions :: !(Bool),o_splitsems_Inh_CProductions :: !(Bool),o_strictwrap_Inh_CProductions :: !(Bool),o_traces_Inh_CProductions :: !(Bool),o_unbox_Inh_CProductions :: !(Bool),options_Inh_CProductions :: !(Options),paramMap_Inh_CProductions :: !(ParamMap),prefix_Inh_CProductions :: !(String),quantMap_Inh_CProductions :: !(QuantMap),syn_Inh_CProductions :: !(Attributes),unfoldSemDom_Inh_CProductions :: !((NontermIdent -> Int -> [String] -> Code.Type)),with_sig_Inh_CProductions :: !(Bool)} +data Syn_CProductions = Syn_CProductions {cataAlts_Syn_CProductions :: !(Decls),comments_Syn_CProductions :: !(([String])),dataAlts_Syn_CProductions :: !(DataAlts),decls_Syn_CProductions :: !(Decls),semNames_Syn_CProductions :: !(([String]))} +wrap_CProductions :: T_CProductions -> + Inh_CProductions -> + Syn_CProductions +wrap_CProductions (T_CProductions sem ) (Inh_CProductions _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig ) = + (let ( _lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOsemNames) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig + in (Syn_CProductions _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOsemNames )) +sem_CProductions_Cons :: T_CProduction -> + T_CProductions -> + T_CProductions +sem_CProductions_Cons (T_CProduction hd_ ) (T_CProductions tl_ ) = + (T_CProductions (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIunfoldSemDom + _lhsIwith_sig -> + (let _lhsOdataAlts :: DataAlts + _lhsOcataAlts :: Decls + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOsemNames :: ([String]) + _hdOallNts :: (Set NontermIdent) + _hdOallPragmas :: PragmaMap + _hdOaroundMap :: (Map ConstructorIdent (Set Identifier)) + _hdOcontextMap :: ContextMap + _hdOinh :: Attributes + _hdOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + _hdOnt :: NontermIdent + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOquantMap :: QuantMap + _hdOsyn :: Attributes + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _hdOwith_sig :: Bool + _tlOallNts :: (Set NontermIdent) + _tlOallPragmas :: PragmaMap + _tlOaroundMap :: (Map ConstructorIdent (Set Identifier)) + _tlOcontextMap :: ContextMap + _tlOinh :: Attributes + _tlOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + _tlOnt :: NontermIdent + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOquantMap :: QuantMap + _tlOsyn :: Attributes + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _tlOwith_sig :: Bool + _hdIcataAlt :: Decl + _hdIcomments :: ([String]) + _hdIdataAlt :: DataAlt + _hdIdecls :: Decls + _hdIsemNames :: ([String]) + _tlIcataAlts :: Decls + _tlIcomments :: ([String]) + _tlIdataAlts :: DataAlts + _tlIdecls :: Decls + _tlIsemNames :: ([String]) + -- "GenerateCode.ag"(line 1010, column 17) + _lhsOdataAlts = + ({-# LINE 1010 "GenerateCode.ag" #-} + _hdIdataAlt : _tlIdataAlts + {-# LINE 2833 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 1111, column 10) + _lhsOcataAlts = + ({-# LINE 1111 "GenerateCode.ag" #-} + _hdIcataAlt : _tlIcataAlts + {-# LINE 2839 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + _hdIcomments ++ _tlIcomments + {-# LINE 2845 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 916, column 44) + _lhsOdecls = + ({-# LINE 916 "GenerateCode.ag" #-} + _hdIdecls ++ _tlIdecls + {-# LINE 2851 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 1131, column 61) + _lhsOsemNames = + ({-# LINE 1131 "GenerateCode.ag" #-} + _hdIsemNames ++ _tlIsemNames + {-# LINE 2857 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 2863 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallPragmas = + ({-# LINE 73 "GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 2869 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 575 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 2875 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcontextMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 2881 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 2887 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 591 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 2893 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 2899 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 2905 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 2911 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 2917 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 2923 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 2929 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 2935 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 2941 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 2947 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 2953 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 2959 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 2965 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 2971 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 2977 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 2983 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 2989 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 2995 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 3001 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 3007 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOquantMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 3013 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 3019 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 3025 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwith_sig = + ({-# LINE 849 "GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 3031 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 3037 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallPragmas = + ({-# LINE 73 "GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 3043 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 575 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 3049 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcontextMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 3055 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 3061 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 591 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 3067 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 3073 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 3079 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 3085 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 3091 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 3097 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 3103 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 3109 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 3115 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 3121 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 3127 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 3133 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 3139 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 3145 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 3151 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 3157 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 3163 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 3169 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 3175 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 3181 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOquantMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 3187 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 3193 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 3199 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwith_sig = + ({-# LINE 849 "GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 3205 "GenerateCode.hs" #-} + ) + ( _hdIcataAlt,_hdIcomments,_hdIdataAlt,_hdIdecls,_hdIsemNames) = + hd_ _hdOallNts _hdOallPragmas _hdOaroundMap _hdOcontextMap _hdOinh _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOquantMap _hdOsyn _hdOunfoldSemDom _hdOwith_sig + ( _tlIcataAlts,_tlIcomments,_tlIdataAlts,_tlIdecls,_tlIsemNames) = + tl_ _tlOallNts _tlOallPragmas _tlOaroundMap _tlOcontextMap _tlOinh _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOquantMap _tlOsyn _tlOunfoldSemDom _tlOwith_sig + in ( _lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOsemNames))) ) +sem_CProductions_Nil :: T_CProductions +sem_CProductions_Nil = + (T_CProductions (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIunfoldSemDom + _lhsIwith_sig -> + (let _lhsOdataAlts :: DataAlts + _lhsOcataAlts :: Decls + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOsemNames :: ([String]) + -- "GenerateCode.ag"(line 1011, column 17) + _lhsOdataAlts = + ({-# LINE 1011 "GenerateCode.ag" #-} + [] + {-# LINE 3252 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 1112, column 10) + _lhsOcataAlts = + ({-# LINE 1112 "GenerateCode.ag" #-} + [] + {-# LINE 3258 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + [] + {-# LINE 3264 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 916, column 44) + _lhsOdecls = + ({-# LINE 916 "GenerateCode.ag" #-} + [] + {-# LINE 3270 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 1131, column 61) + _lhsOsemNames = + ({-# LINE 1131 "GenerateCode.ag" #-} + [] + {-# LINE 3276 "GenerateCode.hs" #-} + ) + in ( _lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOsemNames))) ) +-- CRule ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + aroundMap : Set Identifier + children : [(Identifier,Type,Maybe (Maybe Type))] + con : ConstructorIdent + inh : Attributes + instVisitNrs : Map Identifier Int + mergeMap : Map Identifier (Identifier, [Identifier]) + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramInstMap : Map Identifier (NontermIdent, [String]) + paramMap : ParamMap + prefix : String + syn : Attributes + terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + what : String + chained attributes: + declsAbove : [Decl] + visitedSet : Set Identifier + synthesized attributes: + allTpsFound : Bool + bldBlocksFun : DeclBlocks -> DeclBlocks + comments : [String] + decls : Decls + definedInsts : [Identifier] + exprs : Exprs + tSigs : [Decl] + tps : [Type] + usedVars : Set String + alternatives: + alternative CChildVisit: + child name : {Identifier} + child nt : {NontermIdent} + child nr : {Int} + child inh : {Attributes} + child syn : {Attributes} + child isLast : {Bool} + visit 0: + local visitedSet : _ + local costCentreDescr : _ + local addCostCentre : _ + local decls : _ + local isSuperfluousHigherOrderIntra : _ + local names : _ + local mkTp : _ + local definedTps : _ + local nextTp : _ + local orgParams : _ + local instParams : _ + local replParamMap : _ + local replace : _ + local evalTp : _ + alternative CRule: + child name : {Identifier} + child isIn : {Bool} + child hasCode : {Bool} + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child childnt : {Maybe NontermIdent} + child tp : {Maybe Type} + child pattern : Pattern + child rhs : {[String]} + child defines : {Map Int (Identifier,Identifier,Maybe Type)} + child owrt : {Bool} + child origin : {String} + child uses : {Set (Identifier, Identifier)} + child explicit : {Bool} + child mbNamed : {Maybe Identifier} + visit 0: + local instTypes : _ + local originComment : _ + local instDecls : _ + local patDescr : _ + local traceDescr : _ + local addTrace : _ + local costCentreDescr : _ + local addCostCentre : _ + local addLinePragma : _ + local decls : _ + local definedInsts : _ + local rulename : _ + local mkTp : _ + local orgParams : _ + local evalTp : _ + local _tup3 : {([Type],Bool)} +-} +-- cata +sem_CRule :: CRule -> + T_CRule +sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) = + (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast ) +sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses _explicit _mbNamed ) = + (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern ) _rhs _defines _owrt _origin _uses _explicit _mbNamed ) +-- semantic domain +newtype T_CRule = T_CRule ((Set NontermIdent) -> + (Set Identifier) -> + ([(Identifier,Type,Maybe (Maybe Type))]) -> + ConstructorIdent -> + ([Decl]) -> + Attributes -> + (Map Identifier Int) -> + (Map Identifier (Identifier, [Identifier])) -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + (Map Identifier (NontermIdent, [String])) -> + ParamMap -> + String -> + Attributes -> + ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + (Set Identifier) -> + String -> + ( Bool,(DeclBlocks -> DeclBlocks),([String]),Decls,([Decl]),([Identifier]),Exprs,([Decl]),([Type]),(Set String),(Set Identifier))) +data Inh_CRule = Inh_CRule {allNts_Inh_CRule :: !((Set NontermIdent)),aroundMap_Inh_CRule :: !((Set Identifier)),children_Inh_CRule :: !(([(Identifier,Type,Maybe (Maybe Type))])),con_Inh_CRule :: !(ConstructorIdent),declsAbove_Inh_CRule :: !(([Decl])),inh_Inh_CRule :: !(Attributes),instVisitNrs_Inh_CRule :: !((Map Identifier Int)),mergeMap_Inh_CRule :: !((Map Identifier (Identifier, [Identifier]))),nr_Inh_CRule :: !(Int),nt_Inh_CRule :: !(NontermIdent),o_case_Inh_CRule :: !(Bool),o_cata_Inh_CRule :: !(Bool),o_costcentre_Inh_CRule :: !(Bool),o_data_Inh_CRule :: !((Maybe Bool)),o_linePragmas_Inh_CRule :: !(Bool),o_monadic_Inh_CRule :: !(Bool),o_newtypes_Inh_CRule :: !(Bool),o_pretty_Inh_CRule :: !(Bool),o_rename_Inh_CRule :: !(Bool),o_sem_Inh_CRule :: !(Bool),o_sig_Inh_CRule :: !(Bool),o_splitsems_Inh_CRule :: !(Bool),o_strictwrap_Inh_CRule :: !(Bool),o_traces_Inh_CRule :: !(Bool),o_unbox_Inh_CRule :: !(Bool),options_Inh_CRule :: !(Options),paramInstMap_Inh_CRule :: !((Map Identifier (NontermIdent, [String]))),paramMap_Inh_CRule :: !(ParamMap),prefix_Inh_CRule :: !(String),syn_Inh_CRule :: !(Attributes),terminals_Inh_CRule :: !(([Identifier])),unfoldSemDom_Inh_CRule :: !((NontermIdent -> Int -> [String] -> Code.Type)),visitedSet_Inh_CRule :: !((Set Identifier)),what_Inh_CRule :: !(String)} +data Syn_CRule = Syn_CRule {allTpsFound_Syn_CRule :: !(Bool),bldBlocksFun_Syn_CRule :: !((DeclBlocks -> DeclBlocks)),comments_Syn_CRule :: !(([String])),decls_Syn_CRule :: !(Decls),declsAbove_Syn_CRule :: !(([Decl])),definedInsts_Syn_CRule :: !(([Identifier])),exprs_Syn_CRule :: !(Exprs),tSigs_Syn_CRule :: !(([Decl])),tps_Syn_CRule :: !(([Type])),usedVars_Syn_CRule :: !((Set String)),visitedSet_Syn_CRule :: !((Set Identifier))} +wrap_CRule :: T_CRule -> + Inh_CRule -> + Syn_CRule +wrap_CRule (T_CRule sem ) (Inh_CRule _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat ) = + (let ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet) = sem _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat + in (Syn_CRule _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet )) +sem_CRule_CChildVisit :: Identifier -> + NontermIdent -> + Int -> + Attributes -> + Attributes -> + Bool -> + T_CRule +sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = + (T_CRule (\ _lhsIallNts + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIdeclsAbove + _lhsIinh + _lhsIinstVisitNrs + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwhat -> + (let _lhsOexprs :: Exprs + _lhsOusedVars :: (Set String) + _lhsOtSigs :: ([Decl]) + _lhsOtps :: ([Type]) + _lhsOdeclsAbove :: ([Decl]) + _lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks) + _lhsOallTpsFound :: Bool + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOdefinedInsts :: ([Identifier]) + _lhsOvisitedSet :: (Set Identifier) + -- "GenerateCode.ag"(line 147, column 26) + _visitedSet = + ({-# LINE 147 "GenerateCode.ag" #-} + Set.insert name_ _lhsIvisitedSet + {-# LINE 3494 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 203, column 18) + _costCentreDescr = + ({-# LINE 203 "GenerateCode.ag" #-} + show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_ + {-# LINE 3500 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 204, column 18) + _addCostCentre = + ({-# LINE 204 "GenerateCode.ag" #-} + \v -> if _lhsIo_costcentre + then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v + else v + {-# LINE 3508 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 207, column 18) + _decls = + ({-# LINE 207 "GenerateCode.ag" #-} + let lhsVars = map (attrname True name_) (Map.keys syn_) + ++ if isLast_ then [] else [unwrap ++ funname name_ (nr_+1)] + rhsVars = map (attrname False name_) (Map.keys inh_) + unwrap = if _lhsIo_newtypes then typeName nt_ (nr_ + 1) ++ " " else "" + tuple | isMerging = TupleLhs [locname name_ ++ "_comp"] + | otherwise = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars + rhs = _addCostCentre $ Code.InvokeExpr (typeName nt_ nr_) (SimpleExpr fun) (map SimpleExpr rhsVars) + isVirtual _ [] = False + isVirtual nm ((n,t,mb) : r) + | nm == n = isJust mb + | otherwise = isVirtual nm r + isMerged = name_ `Map.member` _lhsImergeMap + isMerging = name_ `elem` concatMap (\(_,cs) -> cs) (Map.elems _lhsImergeMap) + merges = [ (c,cs) | (c,(_,cs)) <- Map.assocs _lhsImergeMap, all (`Set.member` _visitedSet ) cs, name_ `elem` (c:cs) ] + baseNm = if nr_ == 0 && isVirtual name_ _lhsIchildren + then Ident (getName name_ ++ "_inst") (getPos name_) + else name_ + fun | nr_ == 0 && Set.member name_ _lhsIaroundMap + = locname name_ ++ "_around " ++ funname baseNm 0 + | otherwise = funname baseNm nr_ + outDecls | isMerged = [] + | otherwise = + if isMerging + then [mkDecl _lhsIo_monadic tuple rhs Set.empty Set.empty] + else [Resume _lhsIo_monadic (typeName nt_ nr_) tuple rhs] + outMerged | null merges || nr_ /= 0 = [] + | otherwise = let (c,cs) = head merges + tuple' = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars' + lhsVars' = map (attrname True c) (Map.keys syn_) + ++ if isLast_ then [] else [unwrap ++ funname c (nr_+1)] + rhsVars = [ locname c ++ "_comp" | c <- cs ] + fun = locname c ++ "_merge" + rhs' = App fun (map SimpleExpr rhsVars) + in [Resume _lhsIo_monadic (typeName nt_ nr_) tuple' rhs'] + in + (outDecls ++ outMerged) + {-# LINE 3549 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 325, column 7) + _isSuperfluousHigherOrderIntra = + ({-# LINE 325 "GenerateCode.ag" #-} + _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs + {-# LINE 3555 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 339, column 8) + _names = + ({-# LINE 339 "GenerateCode.ag" #-} + if _isSuperfluousHigherOrderIntra + then [] + else [funname name_ (nr_+1)] + {-# LINE 3563 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 343, column 8) + _lhsOexprs = + ({-# LINE 343 "GenerateCode.ag" #-} + let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id + addType expr | null _instParams = expr + | otherwise = TypedExpr expr (_lhsIunfoldSemDom nt_ (nr_+1) _instParams ) + in map (wrap . addType . SimpleExpr) _names + {-# LINE 3572 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 355, column 7) + _lhsOusedVars = + ({-# LINE 355 "GenerateCode.ag" #-} + Set.fromList _names + {-# LINE 3578 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 394, column 19) + _mkTp = + ({-# LINE 394 "GenerateCode.ag" #-} + _evalTp . typeToCodeType (Just nt_) _orgParams + {-# LINE 3584 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 395, column 19) + _definedTps = + ({-# LINE 395 "GenerateCode.ag" #-} + [ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ] + {-# LINE 3590 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 396, column 19) + _nextTp = + ({-# LINE 396 "GenerateCode.ag" #-} + typeName nt_ (nr_+1) + {-# LINE 3596 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 397, column 19) + _lhsOtSigs = + ({-# LINE 397 "GenerateCode.ag" #-} + (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps + {-# LINE 3602 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 399, column 19) + _orgParams = + ({-# LINE 399 "GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] nt_ _lhsIparamMap + {-# LINE 3608 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 400, column 19) + _instParams = + ({-# LINE 400 "GenerateCode.ag" #-} + snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap + {-# LINE 3614 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 401, column 19) + _replParamMap = + ({-# LINE 401 "GenerateCode.ag" #-} + Map.fromList (zip _orgParams _instParams ) + {-# LINE 3620 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 402, column 19) + _replace = + ({-# LINE 402 "GenerateCode.ag" #-} + \k -> Map.findWithDefault k k _replParamMap + {-# LINE 3626 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 403, column 19) + _evalTp = + ({-# LINE 403 "GenerateCode.ag" #-} + if null _orgParams then id else evalType _replace + {-# LINE 3632 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 426, column 19) + _lhsOtps = + ({-# LINE 426 "GenerateCode.ag" #-} + if _isSuperfluousHigherOrderIntra + then [] + else [NT (ntOfVisit nt_ (nr_+1)) _instParams ] + {-# LINE 3640 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 615, column 7) + _lhsOdeclsAbove = + ({-# LINE 615 "GenerateCode.ag" #-} + [] + {-# LINE 3646 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 628, column 7) + _lhsObldBlocksFun = + ({-# LINE 628 "GenerateCode.ag" #-} + DeclBlock _lhsIdeclsAbove (head _decls ) + {-# LINE 3652 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 423, column 39) + _lhsOallTpsFound = + ({-# LINE 423 "GenerateCode.ag" #-} + True + {-# LINE 3658 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + [] + {-# LINE 3664 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 155, column 34) + _lhsOdecls = + ({-# LINE 155 "GenerateCode.ag" #-} + _decls + {-# LINE 3670 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + [] + {-# LINE 3676 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _lhsOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _visitedSet + {-# LINE 3682 "GenerateCode.hs" #-} + ) + in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet))) ) +sem_CRule_CRule :: Identifier -> + Bool -> + Bool -> + NontermIdent -> + ConstructorIdent -> + Identifier -> + (Maybe NontermIdent) -> + (Maybe Type) -> + T_Pattern -> + ([String]) -> + (Map Int (Identifier,Identifier,Maybe Type)) -> + Bool -> + String -> + (Set (Identifier, Identifier)) -> + Bool -> + (Maybe Identifier) -> + T_CRule +sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ = + (T_CRule (\ _lhsIallNts + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIdeclsAbove + _lhsIinh + _lhsIinstVisitNrs + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwhat -> + (let _lhsOexprs :: Exprs + _lhsOusedVars :: (Set String) + _lhsOtSigs :: ([Decl]) + __tup3 :: (([Type],Bool)) + _lhsOtps :: ([Type]) + _lhsOallTpsFound :: Bool + _lhsOdeclsAbove :: ([Decl]) + _lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks) + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOdefinedInsts :: ([Identifier]) + _lhsOvisitedSet :: (Set Identifier) + _patternIcopy :: Pattern + _patternIdefinedInsts :: ([Identifier]) + _patternIpatternAttributes :: ([(Identifier, Identifier)]) + -- "GenerateCode.ag"(line 157, column 12) + _instTypes = + ({-# LINE 157 "GenerateCode.ag" #-} + [ (n, (t, mb)) | (n, NT t _, mb) <- _lhsIchildren ] + {-# LINE 3756 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 158, column 12) + _originComment = + ({-# LINE 158 "GenerateCode.ag" #-} + if _lhsIo_pretty + then (Comment origin_:) + else id + {-# LINE 3764 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 161, column 12) + _instDecls = + ({-# LINE 161 "GenerateCode.ag" #-} + [ mkDecl _lhsIo_monadic (Pattern3 (Alias _INST' inst (Underscore (getPos inst)) [])) + ( let (nm,mb) = fromJust $ inst `lookup` _instTypes + in unwrapSem _lhsIo_newtypes (maybe nm id (deforestedNt nm)) + $ case mb of + Just (Just tp') -> App instLocFieldName [SimpleExpr $ fieldname inst] + _ -> + case nm `Set.member` _lhsIallNts of + True -> App (cataname _lhsIprefix nm) + [SimpleExpr instLocFieldName] + False -> SimpleExpr instLocFieldName + ) + (Set.singleton instSemFieldName) + (Set.singleton instLocFieldName) + | inst <- _definedInsts + , let instLocFieldName = attrname True _INST inst + instSemFieldName = attrname False _INST' inst + ] + {-# LINE 3786 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 178, column 12) + _patDescr = + ({-# LINE 178 "GenerateCode.ag" #-} + if isIn_ + then "_" + else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes) + {-# LINE 3794 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 181, column 12) + _traceDescr = + ({-# LINE 181 "GenerateCode.ag" #-} + (maybe "" (\nm -> show nm ++ ":") mbNamed_) ++ show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr + {-# LINE 3800 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 183, column 12) + _addTrace = + ({-# LINE 183 "GenerateCode.ag" #-} + \v -> if _lhsIo_traces + then Trace _traceDescr v + else v + {-# LINE 3808 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 186, column 12) + _costCentreDescr = + ({-# LINE 186 "GenerateCode.ag" #-} + show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr + {-# LINE 3814 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 187, column 12) + _addCostCentre = + ({-# LINE 187 "GenerateCode.ag" #-} + \v -> if _lhsIo_costcentre + then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v + else v + {-# LINE 3822 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 190, column 12) + _addLinePragma = + ({-# LINE 190 "GenerateCode.ag" #-} + \v -> let p = getPos name_ + hasPos = line p > 0 && column p >= 0 && not (null (file p)) + in if _lhsIo_linePragmas && hasPos + then PragmaExpr True True ("LINE " ++ show (line p) ++ " " ++ show (file p)) + $ LineExpr + $ v + else v + {-# LINE 3834 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 197, column 12) + _decls = + ({-# LINE 197 "GenerateCode.ag" #-} + if hasCode_ + then _originComment ( mkDecl (_lhsIo_monadic && explicit_) (Pattern3 _patternIcopy) (_addTrace $ _addCostCentre $ _addLinePragma $ (TextExpr rhs_)) + (Set.fromList [attrname False fld nm | (fld,nm,_) <- Map.elems defines_]) + (Set.fromList [attrname True fld nm | (fld,nm) <- Set.toList uses_]) + : _instDecls ) + else _instDecls + {-# LINE 3845 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 264, column 12) + _definedInsts = + ({-# LINE 264 "GenerateCode.ag" #-} + if isIn_ then [] else _patternIdefinedInsts + {-# LINE 3851 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 334, column 12) + _rulename = + ({-# LINE 334 "GenerateCode.ag" #-} + if field_ == _LOC && name_ `elem` _lhsIterminals + then funname name_ 0 + else attrname isIn_ field_ name_ + {-# LINE 3859 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 337, column 12) + _lhsOexprs = + ({-# LINE 337 "GenerateCode.ag" #-} + [SimpleExpr _rulename ] + {-# LINE 3865 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 353, column 7) + _lhsOusedVars = + ({-# LINE 353 "GenerateCode.ag" #-} + Set.singleton _rulename + {-# LINE 3871 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 363, column 19) + _mkTp = + ({-# LINE 363 "GenerateCode.ag" #-} + typeToCodeType (Just _lhsInt) _orgParams + {-# LINE 3877 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 364, column 19) + _lhsOtSigs = + ({-# LINE 364 "GenerateCode.ag" #-} + [ TSig (attrname False field attr) tp' + | (field,attr,tp) <- Map.elems defines_, isJust tp + , let tp1 = _evalTp field $ _mkTp (fromJust tp) + tp' = case findOrigType attr _lhsIchildren of + Just tp' -> let tp'' = case tp' of + NT n params -> NT (Ident ("T_" ++ show n) (getPos n)) params + _ -> tp' + tp2 = _evalTp field $ _mkTp tp'' + in Arr tp2 tp1 + Nothing -> tp1 + findOrigType nm [] = Nothing + findOrigType nm ((n,_,mb) : r) + | nm == n = case mb of + Just (Just orig) -> Just orig + _ -> Nothing + | otherwise = findOrigType nm r + ] + {-# LINE 3899 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 382, column 19) + _orgParams = + ({-# LINE 382 "GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap + {-# LINE 3905 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 383, column 19) + _evalTp = + ({-# LINE 383 "GenerateCode.ag" #-} + \field tp -> let orgFldParams = map getName $ Map.findWithDefault [] childNt _lhsIparamMap + (childNt,instParams) = Map.findWithDefault (_lhsInt,[]) field _lhsIparamInstMap + replMap = Map.fromList (zip orgFldParams instParams) + replace k = Map.findWithDefault ('@':k) k replMap + in if null instParams + then if null _orgParams + then tp + else idEvalType tp + else evalType replace tp + {-# LINE 3919 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 425, column 23) + __tup3 = + ({-# LINE 425 "GenerateCode.ag" #-} + maybe ([],False) (\tp -> ([substSelf (fromJust childnt_) tp],True)) tp_ + {-# LINE 3925 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 425, column 23) + (_lhsOtps,_) = + ({-# LINE 425 "GenerateCode.ag" #-} + __tup3 + {-# LINE 3931 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 425, column 23) + (_,_lhsOallTpsFound) = + ({-# LINE 425 "GenerateCode.ag" #-} + __tup3 + {-# LINE 3937 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 613, column 7) + _lhsOdeclsAbove = + ({-# LINE 613 "GenerateCode.ag" #-} + _lhsIdeclsAbove ++ _decls + {-# LINE 3943 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 626, column 7) + _lhsObldBlocksFun = + ({-# LINE 626 "GenerateCode.ag" #-} + id + {-# LINE 3949 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 900, column 18) + _lhsOcomments = + ({-# LINE 900 "GenerateCode.ag" #-} + [ makeLocalComment 11 _lhsIwhat name tp | (field,name,tp) <- Map.elems defines_, field == _LOC ] + ++ [ makeLocalComment 11 "inst " name tp | (field,name,tp) <- Map.elems defines_, field == _INST ] + {-# LINE 3956 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 155, column 34) + _lhsOdecls = + ({-# LINE 155 "GenerateCode.ag" #-} + _decls + {-# LINE 3962 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + _definedInsts + {-# LINE 3968 "GenerateCode.hs" #-} + ) + -- copy rule (chain) + _lhsOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 3974 "GenerateCode.hs" #-} + ) + ( _patternIcopy,_patternIdefinedInsts,_patternIpatternAttributes) = + pattern_ + in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet))) ) +-- CSegment ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inh : Attributes + isLast : Bool + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + syn : Attributes + synthesized attributes: + comments : [String] + semDom : [Decl] + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + wrapDecls : Decls + alternatives: + alternative CSegment: + child inh : {Attributes} + child syn : {Attributes} + visit 0: + local altSemForm : _ + local tp : _ + local inhTps : _ + local inhTup : _ + local synTps : _ + local curTypeName : _ + local nextTypeName : _ + local indexName : _ + local dataIndex : _ + local indexExpr : _ + local indexStr : _ + local inhInstance : _ + local synInstance : _ + local continuation : _ + local params : _ +-} +-- cata +sem_CSegment :: CSegment -> + T_CSegment +sem_CSegment (CSegment _inh _syn ) = + (sem_CSegment_CSegment _inh _syn ) +-- semantic domain +newtype T_CSegment = T_CSegment (Attributes -> + Bool -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + Attributes -> + ( ([String]),([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls)) +data Inh_CSegment = Inh_CSegment {inh_Inh_CSegment :: !(Attributes),isLast_Inh_CSegment :: !(Bool),nr_Inh_CSegment :: !(Int),nt_Inh_CSegment :: !(NontermIdent),o_case_Inh_CSegment :: !(Bool),o_cata_Inh_CSegment :: !(Bool),o_costcentre_Inh_CSegment :: !(Bool),o_data_Inh_CSegment :: !((Maybe Bool)),o_linePragmas_Inh_CSegment :: !(Bool),o_monadic_Inh_CSegment :: !(Bool),o_newtypes_Inh_CSegment :: !(Bool),o_pretty_Inh_CSegment :: !(Bool),o_rename_Inh_CSegment :: !(Bool),o_sem_Inh_CSegment :: !(Bool),o_sig_Inh_CSegment :: !(Bool),o_splitsems_Inh_CSegment :: !(Bool),o_strictwrap_Inh_CSegment :: !(Bool),o_traces_Inh_CSegment :: !(Bool),o_unbox_Inh_CSegment :: !(Bool),options_Inh_CSegment :: !(Options),paramMap_Inh_CSegment :: !(ParamMap),prefix_Inh_CSegment :: !(String),syn_Inh_CSegment :: !(Attributes)} +data Syn_CSegment = Syn_CSegment {comments_Syn_CSegment :: !(([String])),semDom_Syn_CSegment :: !(([Decl])),semDomUnfoldGath_Syn_CSegment :: !((Map (NontermIdent, Int) ([String], Code.Type))),wrapDecls_Syn_CSegment :: !(Decls)} +wrap_CSegment :: T_CSegment -> + Inh_CSegment -> + Syn_CSegment +wrap_CSegment (T_CSegment sem ) (Inh_CSegment _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn ) = + (let ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = sem _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn + in (Syn_CSegment _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls )) +sem_CSegment_CSegment :: Attributes -> + Attributes -> + T_CSegment +sem_CSegment_CSegment inh_ syn_ = + (T_CSegment (\ _lhsIinh + _lhsIisLast + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIsyn -> + (let _lhsOsemDom :: ([Decl]) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _lhsOwrapDecls :: Decls + _lhsOcomments :: ([String]) + -- "GenerateCode.ag"(line 712, column 15) + _altSemForm = + ({-# LINE 712 "GenerateCode.ag" #-} + breadthFirst _lhsIoptions + {-# LINE 4105 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 713, column 15) + _tp = + ({-# LINE 713 "GenerateCode.ag" #-} + if _altSemForm + then TypeApp (SimpleType "Child") [SimpleType "EvalInfo", _indexExpr ] + else foldr Arr _synTps _inhTps + {-# LINE 4113 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 716, column 15) + _inhTps = + ({-# LINE 716 "GenerateCode.ag" #-} + [typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems inh_] + {-# LINE 4119 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 717, column 15) + _inhTup = + ({-# LINE 717 "GenerateCode.ag" #-} + mkTupleType _lhsIo_unbox (null _inhTps ) _inhTps + {-# LINE 4125 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 718, column 15) + _synTps = + ({-# LINE 718 "GenerateCode.ag" #-} + mkTupleType _lhsIo_unbox (null _inhTps ) ([typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems syn_] ++ _continuation ) + {-# LINE 4131 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 719, column 15) + _curTypeName = + ({-# LINE 719 "GenerateCode.ag" #-} + typeName _lhsInt _lhsInr + {-# LINE 4137 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 720, column 15) + _nextTypeName = + ({-# LINE 720 "GenerateCode.ag" #-} + typeName _lhsInt (_lhsInr + 1) + {-# LINE 4143 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 721, column 15) + _indexName = + ({-# LINE 721 "GenerateCode.ag" #-} + "I_" ++ _curTypeName + {-# LINE 4149 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 722, column 15) + _dataIndex = + ({-# LINE 722 "GenerateCode.ag" #-} + Code.Data _indexName _params [DataAlt _indexName []] False [] + {-# LINE 4155 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 723, column 15) + _indexExpr = + ({-# LINE 723 "GenerateCode.ag" #-} + TypeApp (SimpleType _indexName ) (map (SimpleType . ('@':)) _params ) + {-# LINE 4161 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 724, column 15) + _indexStr = + ({-# LINE 724 "GenerateCode.ag" #-} + "(" ++ _indexName ++ concatMap (\p -> " " ++ p) _params ++ ")" + {-# LINE 4167 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 725, column 15) + _inhInstance = + ({-# LINE 725 "GenerateCode.ag" #-} + Code.Data "instance Inh" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Inh") [_inhTup ] ] False [] + {-# LINE 4173 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 726, column 15) + _synInstance = + ({-# LINE 726 "GenerateCode.ag" #-} + Code.Data "instance Syn" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Syn") [_synTps ] ] False [] + {-# LINE 4179 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 727, column 15) + _continuation = + ({-# LINE 727 "GenerateCode.ag" #-} + if _lhsIisLast + then [] + else [TypeApp (SimpleType _nextTypeName ) (map (SimpleType . ('@':)) _params )] + {-# LINE 4187 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 730, column 15) + _params = + ({-# LINE 730 "GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap + {-# LINE 4193 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 731, column 15) + _lhsOsemDom = + ({-# LINE 731 "GenerateCode.ag" #-} + let name = typeName _lhsInt _lhsInr + evalTp | null _params = id + | otherwise = idEvalType + in ( if _lhsIo_newtypes + then [ Code.NewType name _params name (evalTp _tp ) ] + else [ Code.Type name _params (evalTp _tp ) ] ) + ++ ( if _altSemForm + then [_dataIndex , _inhInstance , _synInstance ] + else [] ) + {-# LINE 4207 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 745, column 7) + _lhsOsemDomUnfoldGath = + ({-# LINE 745 "GenerateCode.ag" #-} + Map.singleton (_lhsInt, _lhsInr) (_params , _tp ) + {-# LINE 4213 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 829, column 15) + _lhsOwrapDecls = + ({-# LINE 829 "GenerateCode.ag" #-} + let lhsVars = map (lhsname False) (Map.keys syn_) + ++ if _lhsIisLast then [] else [unwrap ++ sem (_lhsInr+1)] + rhsVars = map (lhsname True) (Map.keys inh_) + rhs = map SimpleExpr rhsVars + unwrap = if _lhsIo_newtypes then typeName _lhsInt (_lhsInr + 1) ++ " " else "" + var = "sem" + sem 0 = var + sem n = var ++ "_" ++ show n + ntt = typeName _lhsInt _lhsInr + in [ EvalDecl ntt (mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars) (InvokeExpr ntt (SimpleExpr $ sem _lhsInr) rhs) ] + {-# LINE 4228 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 871, column 18) + _lhsOcomments = + ({-# LINE 871 "GenerateCode.ag" #-} + let body = map ind (showsSegment (CSegment inh_ syn_)) + in if null body + then [] + else ("visit " ++ show _lhsInr ++ ":") : body + {-# LINE 4237 "GenerateCode.hs" #-} + ) + in ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))) ) +-- CSegments --------------------------------------------------- +{- + visit 0: + inherited attributes: + inh : Attributes + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + syn : Attributes + synthesized attributes: + comments : [String] + isNil : Bool + semDom : [Decl] + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + wrapDecls : Decls + alternatives: + alternative Cons: + child hd : CSegment + child tl : CSegments + alternative Nil: +-} +-- cata +sem_CSegments :: CSegments -> + T_CSegments +sem_CSegments list = + (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) ) +-- semantic domain +newtype T_CSegments = T_CSegments (Attributes -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + Attributes -> + ( ([String]),Bool,([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls)) +data Inh_CSegments = Inh_CSegments {inh_Inh_CSegments :: !(Attributes),nr_Inh_CSegments :: !(Int),nt_Inh_CSegments :: !(NontermIdent),o_case_Inh_CSegments :: !(Bool),o_cata_Inh_CSegments :: !(Bool),o_costcentre_Inh_CSegments :: !(Bool),o_data_Inh_CSegments :: !((Maybe Bool)),o_linePragmas_Inh_CSegments :: !(Bool),o_monadic_Inh_CSegments :: !(Bool),o_newtypes_Inh_CSegments :: !(Bool),o_pretty_Inh_CSegments :: !(Bool),o_rename_Inh_CSegments :: !(Bool),o_sem_Inh_CSegments :: !(Bool),o_sig_Inh_CSegments :: !(Bool),o_splitsems_Inh_CSegments :: !(Bool),o_strictwrap_Inh_CSegments :: !(Bool),o_traces_Inh_CSegments :: !(Bool),o_unbox_Inh_CSegments :: !(Bool),options_Inh_CSegments :: !(Options),paramMap_Inh_CSegments :: !(ParamMap),prefix_Inh_CSegments :: !(String),syn_Inh_CSegments :: !(Attributes)} +data Syn_CSegments = Syn_CSegments {comments_Syn_CSegments :: !(([String])),isNil_Syn_CSegments :: !(Bool),semDom_Syn_CSegments :: !(([Decl])),semDomUnfoldGath_Syn_CSegments :: !((Map (NontermIdent, Int) ([String], Code.Type))),wrapDecls_Syn_CSegments :: !(Decls)} +wrap_CSegments :: T_CSegments -> + Inh_CSegments -> + Syn_CSegments +wrap_CSegments (T_CSegments sem ) (Inh_CSegments _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn ) = + (let ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = sem _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn + in (Syn_CSegments _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls )) +sem_CSegments_Cons :: T_CSegment -> + T_CSegments -> + T_CSegments +sem_CSegments_Cons (T_CSegment hd_ ) (T_CSegments tl_ ) = + (T_CSegments (\ _lhsIinh + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIsyn -> + (let _tlOnr :: Int + _lhsOisNil :: Bool + _hdOisLast :: Bool + _lhsOcomments :: ([String]) + _lhsOsemDom :: ([Decl]) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _lhsOwrapDecls :: Decls + _hdOinh :: Attributes + _hdOnr :: Int + _hdOnt :: NontermIdent + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOsyn :: Attributes + _tlOinh :: Attributes + _tlOnt :: NontermIdent + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOsyn :: Attributes + _hdIcomments :: ([String]) + _hdIsemDom :: ([Decl]) + _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _hdIwrapDecls :: Decls + _tlIcomments :: ([String]) + _tlIisNil :: Bool + _tlIsemDom :: ([Decl]) + _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _tlIwrapDecls :: Decls + -- "GenerateCode.ag"(line 284, column 11) + _tlOnr = + ({-# LINE 284 "GenerateCode.ag" #-} + _lhsInr + 1 + {-# LINE 4404 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 297, column 12) + _lhsOisNil = + ({-# LINE 297 "GenerateCode.ag" #-} + False + {-# LINE 4410 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 298, column 12) + _hdOisLast = + ({-# LINE 298 "GenerateCode.ag" #-} + _tlIisNil + {-# LINE 4416 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + _hdIcomments ++ _tlIcomments + {-# LINE 4422 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 707, column 50) + _lhsOsemDom = + ({-# LINE 707 "GenerateCode.ag" #-} + _hdIsemDom ++ _tlIsemDom + {-# LINE 4428 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 741, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 741 "GenerateCode.ag" #-} + _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath + {-# LINE 4434 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 827, column 52) + _lhsOwrapDecls = + ({-# LINE 827 "GenerateCode.ag" #-} + _hdIwrapDecls ++ _tlIwrapDecls + {-# LINE 4440 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 4446 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnr = + ({-# LINE 276 "GenerateCode.ag" #-} + _lhsInr + {-# LINE 4452 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 4458 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 4464 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 4470 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 4476 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 4482 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 4488 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 4494 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 4500 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 4506 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 4512 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 4518 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 4524 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 4530 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 4536 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 4542 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 4548 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 4554 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 4560 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 4566 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 4572 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 4578 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 4584 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 4590 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 4596 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 4602 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 4608 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 4614 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 4620 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 4626 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 4632 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 4638 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 4644 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 4650 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 4656 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 4662 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 4668 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 4674 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 4680 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 4686 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 4692 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 4698 "GenerateCode.hs" #-} + ) + ( _hdIcomments,_hdIsemDom,_hdIsemDomUnfoldGath,_hdIwrapDecls) = + hd_ _hdOinh _hdOisLast _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOsyn + ( _tlIcomments,_tlIisNil,_tlIsemDom,_tlIsemDomUnfoldGath,_tlIwrapDecls) = + tl_ _tlOinh _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOsyn + in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))) ) +sem_CSegments_Nil :: T_CSegments +sem_CSegments_Nil = + (T_CSegments (\ _lhsIinh + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIsyn -> + (let _lhsOisNil :: Bool + _lhsOcomments :: ([String]) + _lhsOsemDom :: ([Decl]) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _lhsOwrapDecls :: Decls + -- "GenerateCode.ag"(line 299, column 10) + _lhsOisNil = + ({-# LINE 299 "GenerateCode.ag" #-} + True + {-# LINE 4738 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + [] + {-# LINE 4744 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 707, column 50) + _lhsOsemDom = + ({-# LINE 707 "GenerateCode.ag" #-} + [] + {-# LINE 4750 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 741, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 741 "GenerateCode.ag" #-} + Map.empty + {-# LINE 4756 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 827, column 52) + _lhsOwrapDecls = + ({-# LINE 827 "GenerateCode.ag" #-} + [] + {-# LINE 4762 "GenerateCode.hs" #-} + ) + in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))) ) +-- CVisit ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Set Identifier + children : [(Identifier,Type, Maybe (Maybe Type))] + con : ConstructorIdent + contextMap : ContextMap + inh : Attributes + instVisitNrs : Map Identifier Int + isLast : Bool + mergeMap : Map Identifier (Identifier, [Identifier]) + nextIntra : Exprs + nextIntraVars : Set String + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramInstMap : Map Identifier (NontermIdent, [String]) + paramMap : ParamMap + prefix : String + quantMap : QuantMap + syn : Attributes + terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + chained attributes: + decls : Decls + visitedSet : Set Identifier + synthesized attributes: + comments : [String] + gatherInstVisitNrs : Map Identifier Int + intra : Exprs + intraVars : Set String + semNames : [String] + alternatives: + alternative CVisit: + child inh : {Attributes} + child syn : {Attributes} + child vss : Sequence + child intra : Sequence + child ordered : {Bool} + visit 0: + local _tup4 : _ + local higherOrderChildren : _ + local firstOrderChildren : _ + local firstOrderOrig : _ + local funcname : _ + local nextVisitName : _ + local nextVisitDecl : _ + local decls : _ + local lastExprVars : _ + local _tup5 : _ + local blockFunDecls : _ + local blockFirstFunCall : _ + local costCentreDescr : _ + local addCostCentre : _ + local params : _ + local semFun : _ + local tsig : _ + local semType : _ + local typeSigs : _ + local o_do : _ + local o_case : _ + local declsType : _ + local o_splitsems : _ +-} +-- cata +sem_CVisit :: CVisit -> + T_CVisit +sem_CVisit (CVisit _inh _syn _vss _intra _ordered ) = + (sem_CVisit_CVisit _inh _syn (sem_Sequence _vss ) (sem_Sequence _intra ) _ordered ) +-- semantic domain +newtype T_CVisit = T_CVisit ((Set NontermIdent) -> + PragmaMap -> + (Set Identifier) -> + ([(Identifier,Type, Maybe (Maybe Type))]) -> + ConstructorIdent -> + ContextMap -> + Decls -> + Attributes -> + (Map Identifier Int) -> + Bool -> + (Map Identifier (Identifier, [Identifier])) -> + Exprs -> + (Set String) -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + (Map Identifier (NontermIdent, [String])) -> + ParamMap -> + String -> + QuantMap -> + Attributes -> + ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + (Set Identifier) -> + Bool -> + ( ([String]),Decls,(Map Identifier Int),Exprs,(Set String),([String]),(Set Identifier))) +data Inh_CVisit = Inh_CVisit {allNts_Inh_CVisit :: !((Set NontermIdent)),allPragmas_Inh_CVisit :: !(PragmaMap),aroundMap_Inh_CVisit :: !((Set Identifier)),children_Inh_CVisit :: !(([(Identifier,Type, Maybe (Maybe Type))])),con_Inh_CVisit :: !(ConstructorIdent),contextMap_Inh_CVisit :: !(ContextMap),decls_Inh_CVisit :: !(Decls),inh_Inh_CVisit :: !(Attributes),instVisitNrs_Inh_CVisit :: !((Map Identifier Int)),isLast_Inh_CVisit :: !(Bool),mergeMap_Inh_CVisit :: !((Map Identifier (Identifier, [Identifier]))),nextIntra_Inh_CVisit :: !(Exprs),nextIntraVars_Inh_CVisit :: !((Set String)),nr_Inh_CVisit :: !(Int),nt_Inh_CVisit :: !(NontermIdent),o_case_Inh_CVisit :: !(Bool),o_cata_Inh_CVisit :: !(Bool),o_costcentre_Inh_CVisit :: !(Bool),o_data_Inh_CVisit :: !((Maybe Bool)),o_linePragmas_Inh_CVisit :: !(Bool),o_monadic_Inh_CVisit :: !(Bool),o_newtypes_Inh_CVisit :: !(Bool),o_pretty_Inh_CVisit :: !(Bool),o_rename_Inh_CVisit :: !(Bool),o_sem_Inh_CVisit :: !(Bool),o_sig_Inh_CVisit :: !(Bool),o_splitsems_Inh_CVisit :: !(Bool),o_strictwrap_Inh_CVisit :: !(Bool),o_traces_Inh_CVisit :: !(Bool),o_unbox_Inh_CVisit :: !(Bool),options_Inh_CVisit :: !(Options),paramInstMap_Inh_CVisit :: !((Map Identifier (NontermIdent, [String]))),paramMap_Inh_CVisit :: !(ParamMap),prefix_Inh_CVisit :: !(String),quantMap_Inh_CVisit :: !(QuantMap),syn_Inh_CVisit :: !(Attributes),terminals_Inh_CVisit :: !(([Identifier])),unfoldSemDom_Inh_CVisit :: !((NontermIdent -> Int -> [String] -> Code.Type)),visitedSet_Inh_CVisit :: !((Set Identifier)),with_sig_Inh_CVisit :: !(Bool)} +data Syn_CVisit = Syn_CVisit {comments_Syn_CVisit :: !(([String])),decls_Syn_CVisit :: !(Decls),gatherInstVisitNrs_Syn_CVisit :: !((Map Identifier Int)),intra_Syn_CVisit :: !(Exprs),intraVars_Syn_CVisit :: !((Set String)),semNames_Syn_CVisit :: !(([String])),visitedSet_Syn_CVisit :: !((Set Identifier))} +wrap_CVisit :: T_CVisit -> + Inh_CVisit -> + Syn_CVisit +wrap_CVisit (T_CVisit sem ) (Inh_CVisit _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIdecls _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsImergeMap _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig ) = + (let ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames,_lhsOvisitedSet) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIdecls _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsImergeMap _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig + in (Syn_CVisit _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames _lhsOvisitedSet )) +sem_CVisit_CVisit :: Attributes -> + Attributes -> + T_Sequence -> + T_Sequence -> + Bool -> + T_CVisit +sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_ ) (T_Sequence intra_ ) ordered_ = + (T_CVisit (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIcontextMap + _lhsIdecls + _lhsIinh + _lhsIinstVisitNrs + _lhsIisLast + _lhsImergeMap + _lhsInextIntra + _lhsInextIntraVars + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwith_sig -> + (let _lhsOintra :: Exprs + _lhsOintraVars :: (Set String) + _vssOlastExpr :: Expr + _intraOlastExpr :: Expr + _lhsOdecls :: Decls + _lhsOgatherInstVisitNrs :: (Map Identifier Int) + _vssOdeclsAbove :: ([Decl]) + _intraOdeclsAbove :: ([Decl]) + _lhsOcomments :: ([String]) + _vssOwhat :: String + _intraOwhat :: String + _lhsOsemNames :: ([String]) + _lhsOvisitedSet :: (Set Identifier) + _vssOallNts :: (Set NontermIdent) + _vssOaroundMap :: (Set Identifier) + _vssOchildren :: ([(Identifier,Type,Maybe (Maybe Type))]) + _vssOcon :: ConstructorIdent + _vssOinh :: Attributes + _vssOinstVisitNrs :: (Map Identifier Int) + _vssOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _vssOnr :: Int + _vssOnt :: NontermIdent + _vssOo_case :: Bool + _vssOo_cata :: Bool + _vssOo_costcentre :: Bool + _vssOo_data :: (Maybe Bool) + _vssOo_linePragmas :: Bool + _vssOo_monadic :: Bool + _vssOo_newtypes :: Bool + _vssOo_pretty :: Bool + _vssOo_rename :: Bool + _vssOo_sem :: Bool + _vssOo_sig :: Bool + _vssOo_splitsems :: Bool + _vssOo_strictwrap :: Bool + _vssOo_traces :: Bool + _vssOo_unbox :: Bool + _vssOoptions :: Options + _vssOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _vssOparamMap :: ParamMap + _vssOprefix :: String + _vssOsyn :: Attributes + _vssOterminals :: ([Identifier]) + _vssOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _vssOvisitedSet :: (Set Identifier) + _intraOallNts :: (Set NontermIdent) + _intraOaroundMap :: (Set Identifier) + _intraOchildren :: ([(Identifier,Type,Maybe (Maybe Type))]) + _intraOcon :: ConstructorIdent + _intraOinh :: Attributes + _intraOinstVisitNrs :: (Map Identifier Int) + _intraOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _intraOnr :: Int + _intraOnt :: NontermIdent + _intraOo_case :: Bool + _intraOo_cata :: Bool + _intraOo_costcentre :: Bool + _intraOo_data :: (Maybe Bool) + _intraOo_linePragmas :: Bool + _intraOo_monadic :: Bool + _intraOo_newtypes :: Bool + _intraOo_pretty :: Bool + _intraOo_rename :: Bool + _intraOo_sem :: Bool + _intraOo_sig :: Bool + _intraOo_splitsems :: Bool + _intraOo_strictwrap :: Bool + _intraOo_traces :: Bool + _intraOo_unbox :: Bool + _intraOoptions :: Options + _intraOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _intraOparamMap :: ParamMap + _intraOprefix :: String + _intraOsyn :: Attributes + _intraOterminals :: ([Identifier]) + _intraOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _intraOvisitedSet :: (Set Identifier) + _vssIallTpsFound :: Bool + _vssIblockDecls :: DeclBlocks + _vssIcomments :: ([String]) + _vssIdecls :: Decls + _vssIdeclsAbove :: ([Decl]) + _vssIdefinedInsts :: ([Identifier]) + _vssIexprs :: Exprs + _vssItSigs :: ([Decl]) + _vssItps :: ([Type]) + _vssIusedVars :: (Set String) + _vssIvisitedSet :: (Set Identifier) + _intraIallTpsFound :: Bool + _intraIblockDecls :: DeclBlocks + _intraIcomments :: ([String]) + _intraIdecls :: Decls + _intraIdeclsAbove :: ([Decl]) + _intraIdefinedInsts :: ([Identifier]) + _intraIexprs :: Exprs + _intraItSigs :: ([Decl]) + _intraItps :: ([Type]) + _intraIusedVars :: (Set String) + _intraIvisitedSet :: (Set Identifier) + -- "GenerateCode.ag"(line 308, column 13) + _lhsOintra = + ({-# LINE 308 "GenerateCode.ag" #-} + _intraIexprs + {-# LINE 5053 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 309, column 13) + _lhsOintraVars = + ({-# LINE 309 "GenerateCode.ag" #-} + _intraIusedVars + {-# LINE 5059 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 448, column 13) + __tup4 = + ({-# LINE 448 "GenerateCode.ag" #-} + partition (\(_,_,virt) -> isHigherOrder virt) _lhsIchildren + {-# LINE 5065 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 448, column 13) + (_higherOrderChildren,_) = + ({-# LINE 448 "GenerateCode.ag" #-} + __tup4 + {-# LINE 5071 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 448, column 13) + (_,_firstOrderChildren) = + ({-# LINE 448 "GenerateCode.ag" #-} + __tup4 + {-# LINE 5077 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 449, column 13) + _firstOrderOrig = + ({-# LINE 449 "GenerateCode.ag" #-} + map pickOrigType _firstOrderChildren + {-# LINE 5083 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 450, column 13) + _funcname = + ({-# LINE 450 "GenerateCode.ag" #-} + seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr + {-# LINE 5089 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 451, column 13) + _nextVisitName = + ({-# LINE 451 "GenerateCode.ag" #-} + if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)] + {-# LINE 5095 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 452, column 13) + _nextVisitDecl = + ({-# LINE 452 "GenerateCode.ag" #-} + let lhs = TupleLhs _nextVisitName + rhs = Let _lhsIdecls (SimpleExpr fun) + fun = seqSemname _lhsIprefix _lhsInt _lhsIcon (_lhsInr+1) + in if _lhsIisLast + then [] + else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars] + {-# LINE 5106 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 459, column 13) + _decls = + ({-# LINE 459 "GenerateCode.ag" #-} + _typeSigs ++ _vssIdecls ++ _nextVisitDecl + {-# LINE 5112 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 460, column 13) + _vssOlastExpr = + ({-# LINE 460 "GenerateCode.ag" #-} + mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName + {-# LINE 5118 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 461, column 13) + _intraOlastExpr = + ({-# LINE 461 "GenerateCode.ag" #-} + error "lastExpr: not used here" + {-# LINE 5124 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 462, column 13) + _lastExprVars = + ({-# LINE 462 "GenerateCode.ag" #-} + map (lhsname False) (Map.keys syn_) ++ _nextVisitName + {-# LINE 5130 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 463, column 13) + __tup5 = + ({-# LINE 463 "GenerateCode.ag" #-} + mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls + {-# LINE 5136 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 463, column 13) + (_blockFunDecls,_) = + ({-# LINE 463 "GenerateCode.ag" #-} + __tup5 + {-# LINE 5142 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 463, column 13) + (_,_blockFirstFunCall) = + ({-# LINE 463 "GenerateCode.ag" #-} + __tup5 + {-# LINE 5148 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 465, column 13) + _costCentreDescr = + ({-# LINE 465 "GenerateCode.ag" #-} + "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr + {-# LINE 5154 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 466, column 13) + _addCostCentre = + ({-# LINE 466 "GenerateCode.ag" #-} + \v -> if _lhsIo_costcentre + then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v + else v + {-# LINE 5162 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 470, column 13) + _params = + ({-# LINE 470 "GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap + {-# LINE 5168 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 471, column 13) + _semFun = + ({-# LINE 471 "GenerateCode.ag" #-} + let lhs = Fun _funcname lhs_args + lhs_args = if _lhsInr == 0 then map field _firstOrderOrig else [] + field (name,NT tp tps,_) = let unwrap | _lhsIo_newtypes = \x -> App (sdtype tp) [x] + | otherwise = id + addType expr | null tps = expr + | otherwise = TypedExpr expr (_lhsIunfoldSemDom tp 0 tps) + in unwrap $ addType $ SimpleExpr $ funname name 0 + field (name,tp,_) = let expr = SimpleExpr (funname name 0) + in if null _params + then expr + else TypedExpr expr (idEvalType $ typeToCodeType (Just _lhsInt) _params tp) + mbEvalTp | null _params = const Nothing + | otherwise = Just . idEvalType + rhs = wrap + . mkSemFun _lhsInt _lhsInr [mkLambdaArg (lhsname True nm) (mbEvalTp $ typeToCodeType (Just _lhsInt) _params tp) | (nm,tp) <- Map.assocs inh_] + $ _addCostCentre + $ if ordered_ && _o_splitsems + then _blockFirstFunCall + else mkDecls _declsType _decls + . ResultExpr (typeName _lhsInt _lhsInr) + . mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) + $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName + wrap = if _lhsIo_newtypes + then \x -> App (typeName _lhsInt _lhsInr) [x] + else id + in Decl lhs rhs Set.empty Set.empty + {-# LINE 5199 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 502, column 13) + _tsig = + ({-# LINE 502 "GenerateCode.ag" #-} + TSig _funcname _semType + {-# LINE 5205 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 503, column 13) + _semType = + ({-# LINE 503 "GenerateCode.ag" #-} + let argType (NT tp tps) r | tp /= _SELF = typeAppStrs (sdtype tp) tps `Arr` r + | tp == _SELF = error "GenerateCode: found an intra-type with type SELF, which should have been prevented by CRule.tps" + argType (Haskell tp) r = SimpleType tp `Arr` r + evalTp | null _params = id + | otherwise = idEvalType + in appQuant _lhsIquantMap _lhsInt $ appContext _lhsIcontextMap _lhsInt $ evalTp $ + if _lhsInr == 0 + then foldr argType (typeAppStrs (sdtype _lhsInt ) _params ) (map (\(_,t,_) -> t) _firstOrderOrig ) + else foldr argType (typeAppStrs (typeName _lhsInt _lhsInr) _params ) [] + {-# LINE 5219 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 514, column 13) + _lhsOdecls = + ({-# LINE 514 "GenerateCode.ag" #-} + ( if _lhsIwith_sig + then [_tsig, _semFun] + else [_semFun] + ) ++ + ( if ordered_ && _o_splitsems + then _blockFunDecls + else [] + ) + {-# LINE 5232 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 522, column 13) + _typeSigs = + ({-# LINE 522 "GenerateCode.ag" #-} + if _lhsIo_sig && not _o_case + then _vssItSigs + else [] + {-# LINE 5240 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 525, column 13) + _o_do = + ({-# LINE 525 "GenerateCode.ag" #-} + ordered_ && _lhsIo_monadic + {-# LINE 5246 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 526, column 13) + _o_case = + ({-# LINE 526 "GenerateCode.ag" #-} + not _o_do && _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE) + {-# LINE 5252 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 527, column 13) + _declsType = + ({-# LINE 527 "GenerateCode.ag" #-} + if _o_do + then DeclsDo + else if _o_case + then DeclsCase + else DeclsLet + {-# LINE 5262 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 532, column 13) + _o_splitsems = + ({-# LINE 532 "GenerateCode.ag" #-} + ordered_ && _lhsIo_splitsems + {-# LINE 5268 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 565, column 7) + _lhsOgatherInstVisitNrs = + ({-# LINE 565 "GenerateCode.ag" #-} + Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts] + {-# LINE 5274 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 608, column 7) + _vssOdeclsAbove = + ({-# LINE 608 "GenerateCode.ag" #-} + [] + {-# LINE 5280 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 609, column 7) + _intraOdeclsAbove = + ({-# LINE 609 "GenerateCode.ag" #-} + error "declsAbove: not used here" + {-# LINE 5286 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 891, column 18) + _lhsOcomments = + ({-# LINE 891 "GenerateCode.ag" #-} + let body = map ind (_vssIcomments ++ _intraIcomments) + in if null body + then [] + else ("visit " ++ show _lhsInr ++ ":") : body + {-# LINE 5295 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 895, column 18) + _vssOwhat = + ({-# LINE 895 "GenerateCode.ag" #-} + "local" + {-# LINE 5301 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 896, column 18) + _intraOwhat = + ({-# LINE 896 "GenerateCode.ag" #-} + "intra" + {-# LINE 5307 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 1141, column 7) + _lhsOsemNames = + ({-# LINE 1141 "GenerateCode.ag" #-} + [_funcname ] + {-# LINE 5313 "GenerateCode.hs" #-} + ) + -- copy rule (up) + _lhsOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _intraIvisitedSet + {-# LINE 5319 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 5325 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOaroundMap = + ({-# LINE 577 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 5331 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOchildren = + ({-# LINE 257 "GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 5337 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOcon = + ({-# LINE 89 "GenerateCode.ag" #-} + _lhsIcon + {-# LINE 5343 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 5349 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOinstVisitNrs = + ({-# LINE 557 "GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 5355 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOmergeMap = + ({-# LINE 593 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 5361 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOnr = + ({-# LINE 276 "GenerateCode.ag" #-} + _lhsInr + {-# LINE 5367 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 5373 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _vssOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _o_case + {-# LINE 5379 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 5385 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 5391 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 5397 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 5403 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 5409 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 5415 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 5421 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 5427 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 5433 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 5439 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _vssOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _o_splitsems + {-# LINE 5445 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 5451 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 5457 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 5463 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 5469 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOparamInstMap = + ({-# LINE 101 "GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 5475 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 5481 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 5487 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 5493 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOterminals = + ({-# LINE 90 "GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 5499 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 5505 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 5511 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 5517 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOaroundMap = + ({-# LINE 577 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 5523 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOchildren = + ({-# LINE 257 "GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 5529 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOcon = + ({-# LINE 89 "GenerateCode.ag" #-} + _lhsIcon + {-# LINE 5535 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 5541 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOinstVisitNrs = + ({-# LINE 557 "GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 5547 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOmergeMap = + ({-# LINE 593 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 5553 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOnr = + ({-# LINE 276 "GenerateCode.ag" #-} + _lhsInr + {-# LINE 5559 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 5565 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _intraOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _o_case + {-# LINE 5571 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 5577 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 5583 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 5589 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 5595 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 5601 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 5607 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 5613 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 5619 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 5625 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 5631 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _intraOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _o_splitsems + {-# LINE 5637 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 5643 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 5649 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 5655 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 5661 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOparamInstMap = + ({-# LINE 101 "GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 5667 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 5673 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 5679 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 5685 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOterminals = + ({-# LINE 90 "GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 5691 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 5697 "GenerateCode.hs" #-} + ) + -- copy rule (chain) + _intraOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _vssIvisitedSet + {-# LINE 5703 "GenerateCode.hs" #-} + ) + ( _vssIallTpsFound,_vssIblockDecls,_vssIcomments,_vssIdecls,_vssIdeclsAbove,_vssIdefinedInsts,_vssIexprs,_vssItSigs,_vssItps,_vssIusedVars,_vssIvisitedSet) = + vss_ _vssOallNts _vssOaroundMap _vssOchildren _vssOcon _vssOdeclsAbove _vssOinh _vssOinstVisitNrs _vssOlastExpr _vssOmergeMap _vssOnr _vssOnt _vssOo_case _vssOo_cata _vssOo_costcentre _vssOo_data _vssOo_linePragmas _vssOo_monadic _vssOo_newtypes _vssOo_pretty _vssOo_rename _vssOo_sem _vssOo_sig _vssOo_splitsems _vssOo_strictwrap _vssOo_traces _vssOo_unbox _vssOoptions _vssOparamInstMap _vssOparamMap _vssOprefix _vssOsyn _vssOterminals _vssOunfoldSemDom _vssOvisitedSet _vssOwhat + ( _intraIallTpsFound,_intraIblockDecls,_intraIcomments,_intraIdecls,_intraIdeclsAbove,_intraIdefinedInsts,_intraIexprs,_intraItSigs,_intraItps,_intraIusedVars,_intraIvisitedSet) = + intra_ _intraOallNts _intraOaroundMap _intraOchildren _intraOcon _intraOdeclsAbove _intraOinh _intraOinstVisitNrs _intraOlastExpr _intraOmergeMap _intraOnr _intraOnt _intraOo_case _intraOo_cata _intraOo_costcentre _intraOo_data _intraOo_linePragmas _intraOo_monadic _intraOo_newtypes _intraOo_pretty _intraOo_rename _intraOo_sem _intraOo_sig _intraOo_splitsems _intraOo_strictwrap _intraOo_traces _intraOo_unbox _intraOoptions _intraOparamInstMap _intraOparamMap _intraOprefix _intraOsyn _intraOterminals _intraOunfoldSemDom _intraOvisitedSet _intraOwhat + in ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames,_lhsOvisitedSet))) ) +-- CVisits ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Set Identifier + children : [(Identifier,Type, Maybe (Maybe Type))] + con : ConstructorIdent + contextMap : ContextMap + inh : Attributes + instVisitNrs : Map Identifier Int + mergeMap : Map Identifier (Identifier, [Identifier]) + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramInstMap : Map Identifier (NontermIdent, [String]) + paramMap : ParamMap + prefix : String + quantMap : QuantMap + syn : Attributes + terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + chained attribute: + visitedSet : Set Identifier + synthesized attributes: + comments : [String] + decls : Decls + gatherInstVisitNrs : Map Identifier Int + intra : Exprs + intraVars : Set String + isNil : Bool + semNames : [String] + alternatives: + alternative Cons: + child hd : CVisit + child tl : CVisits + alternative Nil: +-} +-- cata +sem_CVisits :: CVisits -> + T_CVisits +sem_CVisits list = + (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) ) +-- semantic domain +newtype T_CVisits = T_CVisits ((Set NontermIdent) -> + PragmaMap -> + (Set Identifier) -> + ([(Identifier,Type, Maybe (Maybe Type))]) -> + ConstructorIdent -> + ContextMap -> + Attributes -> + (Map Identifier Int) -> + (Map Identifier (Identifier, [Identifier])) -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + (Map Identifier (NontermIdent, [String])) -> + ParamMap -> + String -> + QuantMap -> + Attributes -> + ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + (Set Identifier) -> + Bool -> + ( ([String]),Decls,(Map Identifier Int),Exprs,(Set String),Bool,([String]),(Set Identifier))) +data Inh_CVisits = Inh_CVisits {allNts_Inh_CVisits :: !((Set NontermIdent)),allPragmas_Inh_CVisits :: !(PragmaMap),aroundMap_Inh_CVisits :: !((Set Identifier)),children_Inh_CVisits :: !(([(Identifier,Type, Maybe (Maybe Type))])),con_Inh_CVisits :: !(ConstructorIdent),contextMap_Inh_CVisits :: !(ContextMap),inh_Inh_CVisits :: !(Attributes),instVisitNrs_Inh_CVisits :: !((Map Identifier Int)),mergeMap_Inh_CVisits :: !((Map Identifier (Identifier, [Identifier]))),nr_Inh_CVisits :: !(Int),nt_Inh_CVisits :: !(NontermIdent),o_case_Inh_CVisits :: !(Bool),o_cata_Inh_CVisits :: !(Bool),o_costcentre_Inh_CVisits :: !(Bool),o_data_Inh_CVisits :: !((Maybe Bool)),o_linePragmas_Inh_CVisits :: !(Bool),o_monadic_Inh_CVisits :: !(Bool),o_newtypes_Inh_CVisits :: !(Bool),o_pretty_Inh_CVisits :: !(Bool),o_rename_Inh_CVisits :: !(Bool),o_sem_Inh_CVisits :: !(Bool),o_sig_Inh_CVisits :: !(Bool),o_splitsems_Inh_CVisits :: !(Bool),o_strictwrap_Inh_CVisits :: !(Bool),o_traces_Inh_CVisits :: !(Bool),o_unbox_Inh_CVisits :: !(Bool),options_Inh_CVisits :: !(Options),paramInstMap_Inh_CVisits :: !((Map Identifier (NontermIdent, [String]))),paramMap_Inh_CVisits :: !(ParamMap),prefix_Inh_CVisits :: !(String),quantMap_Inh_CVisits :: !(QuantMap),syn_Inh_CVisits :: !(Attributes),terminals_Inh_CVisits :: !(([Identifier])),unfoldSemDom_Inh_CVisits :: !((NontermIdent -> Int -> [String] -> Code.Type)),visitedSet_Inh_CVisits :: !((Set Identifier)),with_sig_Inh_CVisits :: !(Bool)} +data Syn_CVisits = Syn_CVisits {comments_Syn_CVisits :: !(([String])),decls_Syn_CVisits :: !(Decls),gatherInstVisitNrs_Syn_CVisits :: !((Map Identifier Int)),intra_Syn_CVisits :: !(Exprs),intraVars_Syn_CVisits :: !((Set String)),isNil_Syn_CVisits :: !(Bool),semNames_Syn_CVisits :: !(([String])),visitedSet_Syn_CVisits :: !((Set Identifier))} +wrap_CVisits :: T_CVisits -> + Inh_CVisits -> + Syn_CVisits +wrap_CVisits (T_CVisits sem ) (Inh_CVisits _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig ) = + (let ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames,_lhsOvisitedSet) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig + in (Syn_CVisits _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames _lhsOvisitedSet )) +sem_CVisits_Cons :: T_CVisit -> + T_CVisits -> + T_CVisits +sem_CVisits_Cons (T_CVisit hd_ ) (T_CVisits tl_ ) = + (T_CVisits (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIcontextMap + _lhsIinh + _lhsIinstVisitNrs + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwith_sig -> + (let _tlOnr :: Int + _lhsOisNil :: Bool + _hdOisLast :: Bool + _hdOnextIntra :: Exprs + _hdOnextIntraVars :: (Set String) + _lhsOintra :: Exprs + _lhsOintraVars :: (Set String) + _lhsOdecls :: Decls + _hdOdecls :: Decls + _lhsOcomments :: ([String]) + _lhsOgatherInstVisitNrs :: (Map Identifier Int) + _lhsOsemNames :: ([String]) + _lhsOvisitedSet :: (Set Identifier) + _hdOallNts :: (Set NontermIdent) + _hdOallPragmas :: PragmaMap + _hdOaroundMap :: (Set Identifier) + _hdOchildren :: ([(Identifier,Type, Maybe (Maybe Type))]) + _hdOcon :: ConstructorIdent + _hdOcontextMap :: ContextMap + _hdOinh :: Attributes + _hdOinstVisitNrs :: (Map Identifier Int) + _hdOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _hdOnr :: Int + _hdOnt :: NontermIdent + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOquantMap :: QuantMap + _hdOsyn :: Attributes + _hdOterminals :: ([Identifier]) + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _hdOvisitedSet :: (Set Identifier) + _hdOwith_sig :: Bool + _tlOallNts :: (Set NontermIdent) + _tlOallPragmas :: PragmaMap + _tlOaroundMap :: (Set Identifier) + _tlOchildren :: ([(Identifier,Type, Maybe (Maybe Type))]) + _tlOcon :: ConstructorIdent + _tlOcontextMap :: ContextMap + _tlOinh :: Attributes + _tlOinstVisitNrs :: (Map Identifier Int) + _tlOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _tlOnt :: NontermIdent + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOquantMap :: QuantMap + _tlOsyn :: Attributes + _tlOterminals :: ([Identifier]) + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _tlOvisitedSet :: (Set Identifier) + _tlOwith_sig :: Bool + _hdIcomments :: ([String]) + _hdIdecls :: Decls + _hdIgatherInstVisitNrs :: (Map Identifier Int) + _hdIintra :: Exprs + _hdIintraVars :: (Set String) + _hdIsemNames :: ([String]) + _hdIvisitedSet :: (Set Identifier) + _tlIcomments :: ([String]) + _tlIdecls :: Decls + _tlIgatherInstVisitNrs :: (Map Identifier Int) + _tlIintra :: Exprs + _tlIintraVars :: (Set String) + _tlIisNil :: Bool + _tlIsemNames :: ([String]) + _tlIvisitedSet :: (Set Identifier) + -- "GenerateCode.ag"(line 280, column 11) + _tlOnr = + ({-# LINE 280 "GenerateCode.ag" #-} + _lhsInr + 1 + {-# LINE 5959 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 293, column 12) + _lhsOisNil = + ({-# LINE 293 "GenerateCode.ag" #-} + False + {-# LINE 5965 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 294, column 12) + _hdOisLast = + ({-# LINE 294 "GenerateCode.ag" #-} + _tlIisNil + {-# LINE 5971 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 311, column 12) + _hdOnextIntra = + ({-# LINE 311 "GenerateCode.ag" #-} + _tlIintra + {-# LINE 5977 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 312, column 12) + _hdOnextIntraVars = + ({-# LINE 312 "GenerateCode.ag" #-} + _tlIintraVars + {-# LINE 5983 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 313, column 12) + _lhsOintra = + ({-# LINE 313 "GenerateCode.ag" #-} + _hdIintra + {-# LINE 5989 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 314, column 12) + _lhsOintraVars = + ({-# LINE 314 "GenerateCode.ag" #-} + _hdIintraVars + {-# LINE 5995 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 438, column 11) + _lhsOdecls = + ({-# LINE 438 "GenerateCode.ag" #-} + _hdIdecls + {-# LINE 6001 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 439, column 11) + _hdOdecls = + ({-# LINE 439 "GenerateCode.ag" #-} + _tlIdecls + {-# LINE 6007 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + _hdIcomments ++ _tlIcomments + {-# LINE 6013 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 558, column 44) + _lhsOgatherInstVisitNrs = + ({-# LINE 558 "GenerateCode.ag" #-} + _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs + {-# LINE 6019 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 1131, column 61) + _lhsOsemNames = + ({-# LINE 1131 "GenerateCode.ag" #-} + _hdIsemNames ++ _tlIsemNames + {-# LINE 6025 "GenerateCode.hs" #-} + ) + -- copy rule (up) + _lhsOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _tlIvisitedSet + {-# LINE 6031 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 6037 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallPragmas = + ({-# LINE 73 "GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 6043 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 577 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 6049 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOchildren = + ({-# LINE 417 "GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 6055 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 89 "GenerateCode.ag" #-} + _lhsIcon + {-# LINE 6061 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcontextMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 6067 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 6073 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinstVisitNrs = + ({-# LINE 557 "GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 6079 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 593 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 6085 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnr = + ({-# LINE 276 "GenerateCode.ag" #-} + _lhsInr + {-# LINE 6091 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 6097 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 6103 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 6109 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 6115 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 6121 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 6127 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 6133 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 6139 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 6145 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 6151 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 6157 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 6163 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 6169 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 6175 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 6181 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 6187 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 6193 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamInstMap = + ({-# LINE 101 "GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 6199 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 6205 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 6211 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOquantMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 6217 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 6223 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOterminals = + ({-# LINE 90 "GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 6229 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 6235 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 6241 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwith_sig = + ({-# LINE 849 "GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 6247 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 6253 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallPragmas = + ({-# LINE 73 "GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 6259 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 577 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 6265 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOchildren = + ({-# LINE 417 "GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 6271 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 89 "GenerateCode.ag" #-} + _lhsIcon + {-# LINE 6277 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcontextMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 6283 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 6289 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinstVisitNrs = + ({-# LINE 557 "GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 6295 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 593 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 6301 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 6307 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 6313 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 6319 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 6325 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 6331 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 6337 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 6343 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 6349 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 6355 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 6361 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 6367 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 6373 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 6379 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 6385 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 6391 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 6397 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 6403 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamInstMap = + ({-# LINE 101 "GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 6409 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 6415 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 6421 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOquantMap = + ({-# LINE 115 "GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 6427 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 6433 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOterminals = + ({-# LINE 90 "GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 6439 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 6445 "GenerateCode.hs" #-} + ) + -- copy rule (chain) + _tlOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _hdIvisitedSet + {-# LINE 6451 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwith_sig = + ({-# LINE 849 "GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 6457 "GenerateCode.hs" #-} + ) + ( _hdIcomments,_hdIdecls,_hdIgatherInstVisitNrs,_hdIintra,_hdIintraVars,_hdIsemNames,_hdIvisitedSet) = + hd_ _hdOallNts _hdOallPragmas _hdOaroundMap _hdOchildren _hdOcon _hdOcontextMap _hdOdecls _hdOinh _hdOinstVisitNrs _hdOisLast _hdOmergeMap _hdOnextIntra _hdOnextIntraVars _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamInstMap _hdOparamMap _hdOprefix _hdOquantMap _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOvisitedSet _hdOwith_sig + ( _tlIcomments,_tlIdecls,_tlIgatherInstVisitNrs,_tlIintra,_tlIintraVars,_tlIisNil,_tlIsemNames,_tlIvisitedSet) = + tl_ _tlOallNts _tlOallPragmas _tlOaroundMap _tlOchildren _tlOcon _tlOcontextMap _tlOinh _tlOinstVisitNrs _tlOmergeMap _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamInstMap _tlOparamMap _tlOprefix _tlOquantMap _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOvisitedSet _tlOwith_sig + in ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames,_lhsOvisitedSet))) ) +sem_CVisits_Nil :: T_CVisits +sem_CVisits_Nil = + (T_CVisits (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIcontextMap + _lhsIinh + _lhsIinstVisitNrs + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwith_sig -> + (let _lhsOisNil :: Bool + _lhsOintra :: Exprs + _lhsOintraVars :: (Set String) + _lhsOdecls :: Decls + _lhsOcomments :: ([String]) + _lhsOgatherInstVisitNrs :: (Map Identifier Int) + _lhsOsemNames :: ([String]) + _lhsOvisitedSet :: (Set Identifier) + -- "GenerateCode.ag"(line 295, column 10) + _lhsOisNil = + ({-# LINE 295 "GenerateCode.ag" #-} + True + {-# LINE 6514 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 315, column 10) + _lhsOintra = + ({-# LINE 315 "GenerateCode.ag" #-} + [] + {-# LINE 6520 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 316, column 10) + _lhsOintraVars = + ({-# LINE 316 "GenerateCode.ag" #-} + Set.empty + {-# LINE 6526 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 437, column 11) + _lhsOdecls = + ({-# LINE 437 "GenerateCode.ag" #-} + [] + {-# LINE 6532 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + [] + {-# LINE 6538 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 558, column 44) + _lhsOgatherInstVisitNrs = + ({-# LINE 558 "GenerateCode.ag" #-} + Map.empty + {-# LINE 6544 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 1131, column 61) + _lhsOsemNames = + ({-# LINE 1131 "GenerateCode.ag" #-} + [] + {-# LINE 6550 "GenerateCode.hs" #-} + ) + -- copy rule (chain) + _lhsOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 6556 "GenerateCode.hs" #-} + ) + in ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames,_lhsOvisitedSet))) ) +-- DeclBlocks -------------------------------------------------- +{- + visit 0: + inherited attributes: + blockNr : Int + lastExprVars : [String] + nextVisitDecls : [Decl] + optCase : Bool + prefix : String + synthesized attributes: + callExpr : Expr + decls : [Decl] + freeVars : [String] + alternatives: + alternative DeclBlock: + child defs : {[Decl]} + child visit : {Decl} + child next : DeclBlocks + visit 0: + local lambdaName : _ + local pragmaDecl : _ + local freeVars : _ + local decl : _ + alternative DeclTerminator: + child defs : {[Decl]} + child result : {Expr} + visit 0: + local lambdaName : _ + local pragmaDecl : _ + local freeVars : _ +-} +-- cata +sem_DeclBlocks :: DeclBlocks -> + T_DeclBlocks +sem_DeclBlocks (DeclBlock _defs _visit _next ) = + (sem_DeclBlocks_DeclBlock _defs _visit (sem_DeclBlocks _next ) ) +sem_DeclBlocks (DeclTerminator _defs _result ) = + (sem_DeclBlocks_DeclTerminator _defs _result ) +-- semantic domain +newtype T_DeclBlocks = T_DeclBlocks (Int -> + ([String]) -> + ([Decl]) -> + Bool -> + String -> + ( Expr,([Decl]),([String]))) +data Inh_DeclBlocks = Inh_DeclBlocks {blockNr_Inh_DeclBlocks :: !(Int),lastExprVars_Inh_DeclBlocks :: !(([String])),nextVisitDecls_Inh_DeclBlocks :: !(([Decl])),optCase_Inh_DeclBlocks :: !(Bool),prefix_Inh_DeclBlocks :: !(String)} +data Syn_DeclBlocks = Syn_DeclBlocks {callExpr_Syn_DeclBlocks :: !(Expr),decls_Syn_DeclBlocks :: !(([Decl])),freeVars_Syn_DeclBlocks :: !(([String]))} +wrap_DeclBlocks :: T_DeclBlocks -> + Inh_DeclBlocks -> + Syn_DeclBlocks +wrap_DeclBlocks (T_DeclBlocks sem ) (Inh_DeclBlocks _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix ) = + (let ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars) = sem _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix + in (Syn_DeclBlocks _lhsOcallExpr _lhsOdecls _lhsOfreeVars )) +sem_DeclBlocks_DeclBlock :: ([Decl]) -> + Decl -> + T_DeclBlocks -> + T_DeclBlocks +sem_DeclBlocks_DeclBlock defs_ visit_ (T_DeclBlocks next_ ) = + (T_DeclBlocks (\ _lhsIblockNr + _lhsIlastExprVars + _lhsInextVisitDecls + _lhsIoptCase + _lhsIprefix -> + (let _nextOblockNr :: Int + _lhsOcallExpr :: Expr + _lhsOdecls :: ([Decl]) + _lhsOfreeVars :: ([String]) + _nextOlastExprVars :: ([String]) + _nextOnextVisitDecls :: ([Decl]) + _nextOoptCase :: Bool + _nextOprefix :: String + _nextIcallExpr :: Expr + _nextIdecls :: ([Decl]) + _nextIfreeVars :: ([String]) + -- "GenerateCode.ag"(line 659, column 7) + _nextOblockNr = + ({-# LINE 659 "GenerateCode.ag" #-} + _lhsIblockNr + 1 + {-# LINE 6637 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 664, column 7) + _lambdaName = + ({-# LINE 664 "GenerateCode.ag" #-} + _lhsIprefix ++ "_block" ++ show _lhsIblockNr + {-# LINE 6643 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 665, column 7) + _pragmaDecl = + ({-# LINE 665 "GenerateCode.ag" #-} + PragmaDecl ("NOINLINE " ++ _lambdaName ) + {-# LINE 6649 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 666, column 7) + _lhsOcallExpr = + ({-# LINE 666 "GenerateCode.ag" #-} + App _lambdaName (map SimpleExpr _freeVars ) + {-# LINE 6655 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 670, column 7) + _freeVars = + ({-# LINE 670 "GenerateCode.ag" #-} + freevars _nextIfreeVars (visit_ : defs_) + {-# LINE 6661 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 677, column 7) + _decl = + ({-# LINE 677 "GenerateCode.ag" #-} + mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr + {-# LINE 6667 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 678, column 7) + _lhsOdecls = + ({-# LINE 678 "GenerateCode.ag" #-} + (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls + {-# LINE 6673 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _lhsOfreeVars = + ({-# LINE 661 "GenerateCode.ag" #-} + _freeVars + {-# LINE 6679 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _nextOlastExprVars = + ({-# LINE 645 "GenerateCode.ag" #-} + _lhsIlastExprVars + {-# LINE 6685 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _nextOnextVisitDecls = + ({-# LINE 645 "GenerateCode.ag" #-} + _lhsInextVisitDecls + {-# LINE 6691 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _nextOoptCase = + ({-# LINE 645 "GenerateCode.ag" #-} + _lhsIoptCase + {-# LINE 6697 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _nextOprefix = + ({-# LINE 645 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 6703 "GenerateCode.hs" #-} + ) + ( _nextIcallExpr,_nextIdecls,_nextIfreeVars) = + next_ _nextOblockNr _nextOlastExprVars _nextOnextVisitDecls _nextOoptCase _nextOprefix + in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars))) ) +sem_DeclBlocks_DeclTerminator :: ([Decl]) -> + Expr -> + T_DeclBlocks +sem_DeclBlocks_DeclTerminator defs_ result_ = + (T_DeclBlocks (\ _lhsIblockNr + _lhsIlastExprVars + _lhsInextVisitDecls + _lhsIoptCase + _lhsIprefix -> + (let _lhsOcallExpr :: Expr + _lhsOdecls :: ([Decl]) + _lhsOfreeVars :: ([String]) + -- "GenerateCode.ag"(line 664, column 7) + _lambdaName = + ({-# LINE 664 "GenerateCode.ag" #-} + _lhsIprefix ++ "_block" ++ show _lhsIblockNr + {-# LINE 6724 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 665, column 7) + _pragmaDecl = + ({-# LINE 665 "GenerateCode.ag" #-} + PragmaDecl ("NOINLINE " ++ _lambdaName ) + {-# LINE 6730 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 666, column 7) + _lhsOcallExpr = + ({-# LINE 666 "GenerateCode.ag" #-} + App _lambdaName (map SimpleExpr _freeVars ) + {-# LINE 6736 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 668, column 7) + _freeVars = + ({-# LINE 668 "GenerateCode.ag" #-} + freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls) + {-# LINE 6742 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 675, column 7) + _lhsOdecls = + ({-# LINE 675 "GenerateCode.ag" #-} + [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ] + {-# LINE 6748 "GenerateCode.hs" #-} + ) + -- copy rule (from local) + _lhsOfreeVars = + ({-# LINE 661 "GenerateCode.ag" #-} + _freeVars + {-# LINE 6754 "GenerateCode.hs" #-} + ) + in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars))) ) +-- DeclBlocksRoot ---------------------------------------------- +{- + visit 0: + inherited attributes: + lastExprVars : [String] + nextVisitDecls : [Decl] + optCase : Bool + prefix : String + synthesized attributes: + firstCall : Expr + lambdas : [Decl] + alternatives: + alternative DeclBlocksRoot: + child blocks : DeclBlocks +-} +-- cata +sem_DeclBlocksRoot :: DeclBlocksRoot -> + T_DeclBlocksRoot +sem_DeclBlocksRoot (DeclBlocksRoot _blocks ) = + (sem_DeclBlocksRoot_DeclBlocksRoot (sem_DeclBlocks _blocks ) ) +-- semantic domain +newtype T_DeclBlocksRoot = T_DeclBlocksRoot (([String]) -> + ([Decl]) -> + Bool -> + String -> + ( Expr,([Decl]))) +data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot {lastExprVars_Inh_DeclBlocksRoot :: !(([String])),nextVisitDecls_Inh_DeclBlocksRoot :: !(([Decl])),optCase_Inh_DeclBlocksRoot :: !(Bool),prefix_Inh_DeclBlocksRoot :: !(String)} +data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot {firstCall_Syn_DeclBlocksRoot :: !(Expr),lambdas_Syn_DeclBlocksRoot :: !(([Decl]))} +wrap_DeclBlocksRoot :: T_DeclBlocksRoot -> + Inh_DeclBlocksRoot -> + Syn_DeclBlocksRoot +wrap_DeclBlocksRoot (T_DeclBlocksRoot sem ) (Inh_DeclBlocksRoot _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix ) = + (let ( _lhsOfirstCall,_lhsOlambdas) = sem _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix + in (Syn_DeclBlocksRoot _lhsOfirstCall _lhsOlambdas )) +sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks -> + T_DeclBlocksRoot +sem_DeclBlocksRoot_DeclBlocksRoot (T_DeclBlocks blocks_ ) = + (T_DeclBlocksRoot (\ _lhsIlastExprVars + _lhsInextVisitDecls + _lhsIoptCase + _lhsIprefix -> + (let _lhsOlambdas :: ([Decl]) + _lhsOfirstCall :: Expr + _blocksOblockNr :: Int + _blocksOlastExprVars :: ([String]) + _blocksOnextVisitDecls :: ([Decl]) + _blocksOoptCase :: Bool + _blocksOprefix :: String + _blocksIcallExpr :: Expr + _blocksIdecls :: ([Decl]) + _blocksIfreeVars :: ([String]) + -- "GenerateCode.ag"(line 650, column 7) + _lhsOlambdas = + ({-# LINE 650 "GenerateCode.ag" #-} + _blocksIdecls + {-# LINE 6812 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 651, column 7) + _lhsOfirstCall = + ({-# LINE 651 "GenerateCode.ag" #-} + _blocksIcallExpr + {-# LINE 6818 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 656, column 7) + _blocksOblockNr = + ({-# LINE 656 "GenerateCode.ag" #-} + 1 + {-# LINE 6824 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _blocksOlastExprVars = + ({-# LINE 645 "GenerateCode.ag" #-} + _lhsIlastExprVars + {-# LINE 6830 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _blocksOnextVisitDecls = + ({-# LINE 645 "GenerateCode.ag" #-} + _lhsInextVisitDecls + {-# LINE 6836 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _blocksOoptCase = + ({-# LINE 645 "GenerateCode.ag" #-} + _lhsIoptCase + {-# LINE 6842 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _blocksOprefix = + ({-# LINE 645 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 6848 "GenerateCode.hs" #-} + ) + ( _blocksIcallExpr,_blocksIdecls,_blocksIfreeVars) = + blocks_ _blocksOblockNr _blocksOlastExprVars _blocksOnextVisitDecls _blocksOoptCase _blocksOprefix + in ( _lhsOfirstCall,_lhsOlambdas))) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + definedInsts : [Identifier] + patternAttributes : [(Identifier, Identifier)] + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern ,([Identifier]),([(Identifier, Identifier)]))) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern ),definedInsts_Syn_Pattern :: !(([Identifier])),patternAttributes_Syn_Pattern :: !(([(Identifier, Identifier)]))} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) = sem + in (Syn_Pattern _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIdefinedInsts :: ([Identifier]) + _patIpatternAttributes :: ([(Identifier, Identifier)]) + _partsIcopy :: Patterns + _partsIdefinedInsts :: ([Identifier]) + _partsIpatternAttributes :: ([(Identifier, Identifier)]) + -- "GenerateCode.ag"(line 261, column 11) + _lhsOdefinedInsts = + ({-# LINE 261 "GenerateCode.ag" #-} + (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts + {-# LINE 6929 "GenerateCode.hs" #-} + ) + -- "GenerateCode.ag"(line 269, column 7) + _lhsOpatternAttributes = + ({-# LINE 269 "GenerateCode.ag" #-} + (field_,attr_) : (_patIpatternAttributes ++ _partsIpatternAttributes) + {-# LINE 6935 "GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 6941 "GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 6947 "GenerateCode.hs" #-} + ) + ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) = + pat_ + ( _partsIcopy,_partsIdefinedInsts,_partsIpatternAttributes) = + parts_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIdefinedInsts :: ([Identifier]) + _patsIpatternAttributes :: ([(Identifier, Identifier)]) + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + _patsIdefinedInsts + {-# LINE 6968 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 266, column 47) + _lhsOpatternAttributes = + ({-# LINE 266 "GenerateCode.ag" #-} + _patsIpatternAttributes + {-# LINE 6974 "GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 6980 "GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 6986 "GenerateCode.hs" #-} + ) + ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) = + pats_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIdefinedInsts :: ([Identifier]) + _patIpatternAttributes :: ([(Identifier, Identifier)]) + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + _patIdefinedInsts + {-# LINE 7004 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 266, column 47) + _lhsOpatternAttributes = + ({-# LINE 266 "GenerateCode.ag" #-} + _patIpatternAttributes + {-# LINE 7010 "GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 7016 "GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 7022 "GenerateCode.hs" #-} + ) + ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) = + pat_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIdefinedInsts :: ([Identifier]) + _patsIpatternAttributes :: ([(Identifier, Identifier)]) + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + _patsIdefinedInsts + {-# LINE 7041 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 266, column 47) + _lhsOpatternAttributes = + ({-# LINE 266 "GenerateCode.ag" #-} + _patsIpatternAttributes + {-# LINE 7047 "GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 7053 "GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 7059 "GenerateCode.hs" #-} + ) + ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) = + pats_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + [] + {-# LINE 7074 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 266, column 47) + _lhsOpatternAttributes = + ({-# LINE 266 "GenerateCode.ag" #-} + [] + {-# LINE 7080 "GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 7086 "GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 7092 "GenerateCode.hs" #-} + ) + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + definedInsts : [Identifier] + patternAttributes : [(Identifier, Identifier)] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( Patterns ,([Identifier]),([(Identifier, Identifier)]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns ),definedInsts_Syn_Patterns :: !(([Identifier])),patternAttributes_Syn_Patterns :: !(([(Identifier, Identifier)]))} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) = sem + in (Syn_Patterns _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIdefinedInsts :: ([Identifier]) + _hdIpatternAttributes :: ([(Identifier, Identifier)]) + _tlIcopy :: Patterns + _tlIdefinedInsts :: ([Identifier]) + _tlIpatternAttributes :: ([(Identifier, Identifier)]) + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + _hdIdefinedInsts ++ _tlIdefinedInsts + {-# LINE 7144 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 266, column 47) + _lhsOpatternAttributes = + ({-# LINE 266 "GenerateCode.ag" #-} + _hdIpatternAttributes ++ _tlIpatternAttributes + {-# LINE 7150 "GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 7156 "GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 7162 "GenerateCode.hs" #-} + ) + ( _hdIcopy,_hdIdefinedInsts,_hdIpatternAttributes) = + hd_ + ( _tlIcopy,_tlIdefinedInsts,_tlIpatternAttributes) = + tl_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Patterns + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + [] + {-# LINE 7178 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 266, column 47) + _lhsOpatternAttributes = + ({-# LINE 266 "GenerateCode.ag" #-} + [] + {-# LINE 7184 "GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 7190 "GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 7196 "GenerateCode.hs" #-} + ) + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) +-- Sequence ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + aroundMap : Set Identifier + children : [(Identifier,Type,Maybe (Maybe Type))] + con : ConstructorIdent + inh : Attributes + instVisitNrs : Map Identifier Int + lastExpr : Expr + mergeMap : Map Identifier (Identifier, [Identifier]) + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramInstMap : Map Identifier (NontermIdent, [String]) + paramMap : ParamMap + prefix : String + syn : Attributes + terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + what : String + chained attributes: + declsAbove : [Decl] + visitedSet : Set Identifier + synthesized attributes: + allTpsFound : Bool + blockDecls : DeclBlocks + comments : [String] + decls : Decls + definedInsts : [Identifier] + exprs : Exprs + tSigs : [Decl] + tps : [Type] + usedVars : Set String + alternatives: + alternative Cons: + child hd : CRule + child tl : Sequence + alternative Nil: +-} +-- cata +sem_Sequence :: Sequence -> + T_Sequence +sem_Sequence list = + (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) ) +-- semantic domain +newtype T_Sequence = T_Sequence ((Set NontermIdent) -> + (Set Identifier) -> + ([(Identifier,Type,Maybe (Maybe Type))]) -> + ConstructorIdent -> + ([Decl]) -> + Attributes -> + (Map Identifier Int) -> + Expr -> + (Map Identifier (Identifier, [Identifier])) -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + (Map Identifier (NontermIdent, [String])) -> + ParamMap -> + String -> + Attributes -> + ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + (Set Identifier) -> + String -> + ( Bool,DeclBlocks ,([String]),Decls,([Decl]),([Identifier]),Exprs,([Decl]),([Type]),(Set String),(Set Identifier))) +data Inh_Sequence = Inh_Sequence {allNts_Inh_Sequence :: !((Set NontermIdent)),aroundMap_Inh_Sequence :: !((Set Identifier)),children_Inh_Sequence :: !(([(Identifier,Type,Maybe (Maybe Type))])),con_Inh_Sequence :: !(ConstructorIdent),declsAbove_Inh_Sequence :: !(([Decl])),inh_Inh_Sequence :: !(Attributes),instVisitNrs_Inh_Sequence :: !((Map Identifier Int)),lastExpr_Inh_Sequence :: !(Expr),mergeMap_Inh_Sequence :: !((Map Identifier (Identifier, [Identifier]))),nr_Inh_Sequence :: !(Int),nt_Inh_Sequence :: !(NontermIdent),o_case_Inh_Sequence :: !(Bool),o_cata_Inh_Sequence :: !(Bool),o_costcentre_Inh_Sequence :: !(Bool),o_data_Inh_Sequence :: !((Maybe Bool)),o_linePragmas_Inh_Sequence :: !(Bool),o_monadic_Inh_Sequence :: !(Bool),o_newtypes_Inh_Sequence :: !(Bool),o_pretty_Inh_Sequence :: !(Bool),o_rename_Inh_Sequence :: !(Bool),o_sem_Inh_Sequence :: !(Bool),o_sig_Inh_Sequence :: !(Bool),o_splitsems_Inh_Sequence :: !(Bool),o_strictwrap_Inh_Sequence :: !(Bool),o_traces_Inh_Sequence :: !(Bool),o_unbox_Inh_Sequence :: !(Bool),options_Inh_Sequence :: !(Options),paramInstMap_Inh_Sequence :: !((Map Identifier (NontermIdent, [String]))),paramMap_Inh_Sequence :: !(ParamMap),prefix_Inh_Sequence :: !(String),syn_Inh_Sequence :: !(Attributes),terminals_Inh_Sequence :: !(([Identifier])),unfoldSemDom_Inh_Sequence :: !((NontermIdent -> Int -> [String] -> Code.Type)),visitedSet_Inh_Sequence :: !((Set Identifier)),what_Inh_Sequence :: !(String)} +data Syn_Sequence = Syn_Sequence {allTpsFound_Syn_Sequence :: !(Bool),blockDecls_Syn_Sequence :: !(DeclBlocks ),comments_Syn_Sequence :: !(([String])),decls_Syn_Sequence :: !(Decls),declsAbove_Syn_Sequence :: !(([Decl])),definedInsts_Syn_Sequence :: !(([Identifier])),exprs_Syn_Sequence :: !(Exprs),tSigs_Syn_Sequence :: !(([Decl])),tps_Syn_Sequence :: !(([Type])),usedVars_Syn_Sequence :: !((Set String)),visitedSet_Syn_Sequence :: !((Set Identifier))} +wrap_Sequence :: T_Sequence -> + Inh_Sequence -> + Syn_Sequence +wrap_Sequence (T_Sequence sem ) (Inh_Sequence _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat ) = + (let ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet) = sem _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat + in (Syn_Sequence _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet )) +sem_Sequence_Cons :: T_CRule -> + T_Sequence -> + T_Sequence +sem_Sequence_Cons (T_CRule hd_ ) (T_Sequence tl_ ) = + (T_Sequence (\ _lhsIallNts + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIdeclsAbove + _lhsIinh + _lhsIinstVisitNrs + _lhsIlastExpr + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwhat -> + (let _lhsOblockDecls :: DeclBlocks + _lhsOallTpsFound :: Bool + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOdefinedInsts :: ([Identifier]) + _lhsOexprs :: Exprs + _lhsOtSigs :: ([Decl]) + _lhsOtps :: ([Type]) + _lhsOusedVars :: (Set String) + _lhsOdeclsAbove :: ([Decl]) + _lhsOvisitedSet :: (Set Identifier) + _hdOallNts :: (Set NontermIdent) + _hdOaroundMap :: (Set Identifier) + _hdOchildren :: ([(Identifier,Type,Maybe (Maybe Type))]) + _hdOcon :: ConstructorIdent + _hdOdeclsAbove :: ([Decl]) + _hdOinh :: Attributes + _hdOinstVisitNrs :: (Map Identifier Int) + _hdOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _hdOnr :: Int + _hdOnt :: NontermIdent + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOsyn :: Attributes + _hdOterminals :: ([Identifier]) + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _hdOvisitedSet :: (Set Identifier) + _hdOwhat :: String + _tlOallNts :: (Set NontermIdent) + _tlOaroundMap :: (Set Identifier) + _tlOchildren :: ([(Identifier,Type,Maybe (Maybe Type))]) + _tlOcon :: ConstructorIdent + _tlOdeclsAbove :: ([Decl]) + _tlOinh :: Attributes + _tlOinstVisitNrs :: (Map Identifier Int) + _tlOlastExpr :: Expr + _tlOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _tlOnr :: Int + _tlOnt :: NontermIdent + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOsyn :: Attributes + _tlOterminals :: ([Identifier]) + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _tlOvisitedSet :: (Set Identifier) + _tlOwhat :: String + _hdIallTpsFound :: Bool + _hdIbldBlocksFun :: (DeclBlocks -> DeclBlocks) + _hdIcomments :: ([String]) + _hdIdecls :: Decls + _hdIdeclsAbove :: ([Decl]) + _hdIdefinedInsts :: ([Identifier]) + _hdIexprs :: Exprs + _hdItSigs :: ([Decl]) + _hdItps :: ([Type]) + _hdIusedVars :: (Set String) + _hdIvisitedSet :: (Set Identifier) + _tlIallTpsFound :: Bool + _tlIblockDecls :: DeclBlocks + _tlIcomments :: ([String]) + _tlIdecls :: Decls + _tlIdeclsAbove :: ([Decl]) + _tlIdefinedInsts :: ([Identifier]) + _tlIexprs :: Exprs + _tlItSigs :: ([Decl]) + _tlItps :: ([Type]) + _tlIusedVars :: (Set String) + _tlIvisitedSet :: (Set Identifier) + -- "GenerateCode.ag"(line 619, column 7) + _lhsOblockDecls = + ({-# LINE 619 "GenerateCode.ag" #-} + _hdIbldBlocksFun _tlIblockDecls + {-# LINE 7450 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 423, column 39) + _lhsOallTpsFound = + ({-# LINE 423 "GenerateCode.ag" #-} + _hdIallTpsFound && _tlIallTpsFound + {-# LINE 7456 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + _hdIcomments ++ _tlIcomments + {-# LINE 7462 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 155, column 34) + _lhsOdecls = + ({-# LINE 155 "GenerateCode.ag" #-} + _hdIdecls ++ _tlIdecls + {-# LINE 7468 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + _hdIdefinedInsts ++ _tlIdefinedInsts + {-# LINE 7474 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 332, column 34) + _lhsOexprs = + ({-# LINE 332 "GenerateCode.ag" #-} + _hdIexprs ++ _tlIexprs + {-# LINE 7480 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 361, column 33) + _lhsOtSigs = + ({-# LINE 361 "GenerateCode.ag" #-} + _hdItSigs ++ _tlItSigs + {-# LINE 7486 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 422, column 31) + _lhsOtps = + ({-# LINE 422 "GenerateCode.ag" #-} + _hdItps ++ _tlItps + {-# LINE 7492 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 350, column 37) + _lhsOusedVars = + ({-# LINE 350 "GenerateCode.ag" #-} + _hdIusedVars `Set.union` _tlIusedVars + {-# LINE 7498 "GenerateCode.hs" #-} + ) + -- copy rule (up) + _lhsOdeclsAbove = + ({-# LINE 605 "GenerateCode.ag" #-} + _tlIdeclsAbove + {-# LINE 7504 "GenerateCode.hs" #-} + ) + -- copy rule (up) + _lhsOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _tlIvisitedSet + {-# LINE 7510 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 7516 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 577 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 7522 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOchildren = + ({-# LINE 257 "GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 7528 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 89 "GenerateCode.ag" #-} + _lhsIcon + {-# LINE 7534 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOdeclsAbove = + ({-# LINE 605 "GenerateCode.ag" #-} + _lhsIdeclsAbove + {-# LINE 7540 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 7546 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinstVisitNrs = + ({-# LINE 557 "GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 7552 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 593 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 7558 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnr = + ({-# LINE 276 "GenerateCode.ag" #-} + _lhsInr + {-# LINE 7564 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 7570 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 7576 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 7582 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 7588 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 7594 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 7600 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 7606 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 7612 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 7618 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 7624 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 7630 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 7636 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 7642 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 7648 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 7654 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 7660 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 7666 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamInstMap = + ({-# LINE 101 "GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 7672 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 7678 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 7684 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 7690 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOterminals = + ({-# LINE 90 "GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 7696 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 7702 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 7708 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwhat = + ({-# LINE 868 "GenerateCode.ag" #-} + _lhsIwhat + {-# LINE 7714 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallNts = + ({-# LINE 132 "GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 7720 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 577 "GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 7726 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOchildren = + ({-# LINE 257 "GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 7732 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 89 "GenerateCode.ag" #-} + _lhsIcon + {-# LINE 7738 "GenerateCode.hs" #-} + ) + -- copy rule (chain) + _tlOdeclsAbove = + ({-# LINE 605 "GenerateCode.ag" #-} + _hdIdeclsAbove + {-# LINE 7744 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIinh + {-# LINE 7750 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinstVisitNrs = + ({-# LINE 557 "GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 7756 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOlastExpr = + ({-# LINE 603 "GenerateCode.ag" #-} + _lhsIlastExpr + {-# LINE 7762 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 593 "GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 7768 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnr = + ({-# LINE 276 "GenerateCode.ag" #-} + _lhsInr + {-# LINE 7774 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsInt + {-# LINE 7780 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 7786 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 7792 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 7798 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 7804 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 7810 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 7816 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 7822 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 7828 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 7834 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 7840 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 7846 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 7852 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 7858 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 7864 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 7870 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 7876 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamInstMap = + ({-# LINE 101 "GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 7882 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 7888 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 7894 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 84 "GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 7900 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOterminals = + ({-# LINE 90 "GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 7906 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOunfoldSemDom = + ({-# LINE 747 "GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 7912 "GenerateCode.hs" #-} + ) + -- copy rule (chain) + _tlOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _hdIvisitedSet + {-# LINE 7918 "GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwhat = + ({-# LINE 868 "GenerateCode.ag" #-} + _lhsIwhat + {-# LINE 7924 "GenerateCode.hs" #-} + ) + ( _hdIallTpsFound,_hdIbldBlocksFun,_hdIcomments,_hdIdecls,_hdIdeclsAbove,_hdIdefinedInsts,_hdIexprs,_hdItSigs,_hdItps,_hdIusedVars,_hdIvisitedSet) = + hd_ _hdOallNts _hdOaroundMap _hdOchildren _hdOcon _hdOdeclsAbove _hdOinh _hdOinstVisitNrs _hdOmergeMap _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOvisitedSet _hdOwhat + ( _tlIallTpsFound,_tlIblockDecls,_tlIcomments,_tlIdecls,_tlIdeclsAbove,_tlIdefinedInsts,_tlIexprs,_tlItSigs,_tlItps,_tlIusedVars,_tlIvisitedSet) = + tl_ _tlOallNts _tlOaroundMap _tlOchildren _tlOcon _tlOdeclsAbove _tlOinh _tlOinstVisitNrs _tlOlastExpr _tlOmergeMap _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOvisitedSet _tlOwhat + in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet))) ) +sem_Sequence_Nil :: T_Sequence +sem_Sequence_Nil = + (T_Sequence (\ _lhsIallNts + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIdeclsAbove + _lhsIinh + _lhsIinstVisitNrs + _lhsIlastExpr + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwhat -> + (let _lhsOblockDecls :: DeclBlocks + _lhsOallTpsFound :: Bool + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOdefinedInsts :: ([Identifier]) + _lhsOexprs :: Exprs + _lhsOtSigs :: ([Decl]) + _lhsOtps :: ([Type]) + _lhsOusedVars :: (Set String) + _lhsOdeclsAbove :: ([Decl]) + _lhsOvisitedSet :: (Set Identifier) + -- "GenerateCode.ag"(line 621, column 7) + _lhsOblockDecls = + ({-# LINE 621 "GenerateCode.ag" #-} + DeclTerminator _lhsIdeclsAbove _lhsIlastExpr + {-# LINE 7983 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 423, column 39) + _lhsOallTpsFound = + ({-# LINE 423 "GenerateCode.ag" #-} + True + {-# LINE 7989 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 866, column 52) + _lhsOcomments = + ({-# LINE 866 "GenerateCode.ag" #-} + [] + {-# LINE 7995 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 155, column 34) + _lhsOdecls = + ({-# LINE 155 "GenerateCode.ag" #-} + [] + {-# LINE 8001 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 259, column 55) + _lhsOdefinedInsts = + ({-# LINE 259 "GenerateCode.ag" #-} + [] + {-# LINE 8007 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 332, column 34) + _lhsOexprs = + ({-# LINE 332 "GenerateCode.ag" #-} + [] + {-# LINE 8013 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 361, column 33) + _lhsOtSigs = + ({-# LINE 361 "GenerateCode.ag" #-} + [] + {-# LINE 8019 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 422, column 31) + _lhsOtps = + ({-# LINE 422 "GenerateCode.ag" #-} + [] + {-# LINE 8025 "GenerateCode.hs" #-} + ) + -- use rule "GenerateCode.ag"(line 350, column 37) + _lhsOusedVars = + ({-# LINE 350 "GenerateCode.ag" #-} + Set.empty + {-# LINE 8031 "GenerateCode.hs" #-} + ) + -- copy rule (chain) + _lhsOdeclsAbove = + ({-# LINE 605 "GenerateCode.ag" #-} + _lhsIdeclsAbove + {-# LINE 8037 "GenerateCode.hs" #-} + ) + -- copy rule (chain) + _lhsOvisitedSet = + ({-# LINE 145 "GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 8043 "GenerateCode.hs" #-} + ) + in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet))) ) diff --git a/src-derived/HsToken.hs b/src-derived/HsToken.hs new file mode 100644 --- /dev/null +++ b/src-derived/HsToken.hs @@ -0,0 +1,57 @@ + + +-- UUAGC 0.9.38.2 (HsToken.ag) +module HsToken where +{-# LINE 2 "HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 10 "../src-derived/HsToken.hs" #-} +-- HsToken ----------------------------------------------------- +{- + alternatives: + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} +-} +data HsToken = AGField (Identifier) (Identifier) (Pos) ((Maybe String)) + | AGLocal (Identifier) (Pos) ((Maybe String)) + | CharToken (String) (Pos) + | Err (String) (Pos) + | HsToken (String) (Pos) + | StrToken (String) (Pos) + deriving ( Show) +-- HsTokens ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +type HsTokens = [HsToken ] +-- HsTokensRoot ------------------------------------------------ +{- + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +data HsTokensRoot = HsTokensRoot (HsTokens ) diff --git a/src-derived/Interfaces.hs b/src-derived/Interfaces.hs new file mode 100644 --- /dev/null +++ b/src-derived/Interfaces.hs @@ -0,0 +1,51 @@ + + +-- UUAGC 0.9.38.1 (Interfaces.ag) +module Interfaces where +{-# LINE 2 "Interfaces.ag" #-} + +import CommonTypes +import SequentialTypes +{-# LINE 10 "../src-derived/Interfaces.hs" #-} +-- IRoot ------------------------------------------------------- +{- + alternatives: + alternative IRoot: + child inters : Interfaces +-} +data IRoot = IRoot (Interfaces ) +-- Interface --------------------------------------------------- +{- + alternatives: + alternative Interface: + child nt : {NontermIdent} + child cons : {[ConstructorIdent]} + child seg : Segments +-} +data Interface = Interface (NontermIdent) (([ConstructorIdent])) (Segments ) +-- Interfaces -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Interface + child tl : Interfaces + alternative Nil: +-} +type Interfaces = [Interface ] +-- Segment ----------------------------------------------------- +{- + alternatives: + alternative Segment: + child inh : {[Vertex]} + child syn : {[Vertex]} +-} +data Segment = Segment (([Vertex])) (([Vertex])) +-- Segments ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Segment + child tl : Segments + alternative Nil: +-} +type Segments = [Segment ] diff --git a/src-derived/InterfacesRules.hs b/src-derived/InterfacesRules.hs new file mode 100644 --- /dev/null +++ b/src-derived/InterfacesRules.hs @@ -0,0 +1,1376 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.38.1 (InterfacesRules.lag) +module InterfacesRules where +{-# LINE 10 "InterfacesRules.lag" #-} + +import Interfaces +import SequentialTypes +import CodeSyntax +import GrammarInfo + +import qualified Data.Sequence as Seq +import Data.Sequence(Seq) +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Set as Set +import Data.Set(Set) +import Data.Tree(Tree(Node)) +import Data.Graph(Graph, dfs, edges, buildG, transposeG) +import Data.Maybe (fromJust) +import Data.List (partition,transpose,(\\),nub,intersect, findIndex) +import Data.Array ((!),inRange,bounds,assocs) +import Data.Foldable(toList) + +import Debug.Trace(trace) +{-# LINE 27 "../src-derived/InterfacesRules.hs" #-} + +{-# LINE 2 "./Interfaces.ag" #-} + +import CommonTypes +import SequentialTypes +{-# LINE 33 "../src-derived/InterfacesRules.hs" #-} +{-# LINE 58 "InterfacesRules.lag" #-} + +type VisitSS = [Vertex] +{-# LINE 37 "../src-derived/InterfacesRules.hs" #-} + +{-# LINE 93 "InterfacesRules.lag" #-} + +gather :: Info -> [Vertex] -> [[Vertex]] +gather info = eqClasses comp + where comp a b = isEqualField (ruleTable info ! a) (ruleTable info ! b) +{-# LINE 44 "../src-derived/InterfacesRules.hs" #-} + +{-# LINE 134 "InterfacesRules.lag" #-} + +-- Only non-empty syn will ever be forced, because visits with empty syn are never performed +-- Right hand side synthesized attributes always have a field +cv :: (Vertex -> CRule) -> Int -> Vertex -> ([Vertex],[Vertex]) -> (Vertex,ChildVisit) +cv look n v (inh,syn) = let fld = getField (look (head syn)) + rnt = fromJust (getRhsNt (look (head syn))) + d = ChildVisit fld rnt n inh syn + in (v,d) +{-# LINE 55 "../src-derived/InterfacesRules.hs" #-} + +{-# LINE 157 "InterfacesRules.lag" #-} + +ed v (inh,syn) = map (\i -> (i,v)) inh ++ map (\s -> (v,s)) syn +{-# LINE 60 "../src-derived/InterfacesRules.hs" #-} + +{-# LINE 244 "InterfacesRules.lag" #-} + +postorder (Node a ts) = postorderF ts ++ [a] +postorderF = concatMap postorder +postOrd g = postorderF . dfs g +topSort' g = postOrd g +{-# LINE 68 "../src-derived/InterfacesRules.hs" #-} + +{-# LINE 323 "InterfacesRules.lag" #-} + +type IntraVisit = [Vertex] +{-# LINE 73 "../src-derived/InterfacesRules.hs" #-} + +{-# LINE 345 "InterfacesRules.lag" #-} + +swap (a,b) = (b,a) +{-# LINE 78 "../src-derived/InterfacesRules.hs" #-} + +{-# LINE 419 "InterfacesRules.lag" #-} + +ccv :: Identifier -> NontermIdent -> Int -> CInterfaceMap -> CRule +ccv name nt n table + = CChildVisit name nt n inh syn last + where CInterface segs = Map.findWithDefault (error ("InterfacesRules::ccv::interfaces not in table for nt: " ++ show nt)) nt table + (seg:remain) = drop n segs + CSegment inh syn = seg + last = null remain +{-# LINE 89 "../src-derived/InterfacesRules.hs" #-} +-- IRoot ------------------------------------------------------- +{- + visit 0: + inherited attributes: + dpr : [Edge] + info : Info + tdp : Graph + synthesized attributes: + edp : [Edge] + inters : CInterfaceMap + visits : CVisitsMap + alternatives: + alternative IRoot: + child inters : Interfaces + visit 0: + local newedges : _ + local visitssGraph : _ + local descr : _ +-} +-- cata +sem_IRoot :: IRoot -> + T_IRoot +sem_IRoot !(IRoot _inters ) = + (sem_IRoot_IRoot (sem_Interfaces _inters ) ) +-- semantic domain +newtype T_IRoot = T_IRoot (([Edge]) -> + Info -> + Graph -> + ( ([Edge]),CInterfaceMap,CVisitsMap)) +data Inh_IRoot = Inh_IRoot {dpr_Inh_IRoot :: !(([Edge])),info_Inh_IRoot :: !(Info),tdp_Inh_IRoot :: !(Graph)} +data Syn_IRoot = Syn_IRoot {edp_Syn_IRoot :: !(([Edge])),inters_Syn_IRoot :: !(CInterfaceMap),visits_Syn_IRoot :: !(CVisitsMap)} +wrap_IRoot :: T_IRoot -> + Inh_IRoot -> + Syn_IRoot +wrap_IRoot !(T_IRoot sem ) !(Inh_IRoot _lhsIdpr _lhsIinfo _lhsItdp ) = + (let ( !_lhsOedp,!_lhsOinters,!_lhsOvisits) = sem _lhsIdpr _lhsIinfo _lhsItdp + in (Syn_IRoot _lhsOedp _lhsOinters _lhsOvisits )) +sem_IRoot_IRoot :: T_Interfaces -> + T_IRoot +sem_IRoot_IRoot !(T_Interfaces inters_ ) = + (T_IRoot (\ (!_lhsIdpr) + (!_lhsIinfo) + (!_lhsItdp) -> + (case (({-# LINE 83 "InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 135 "InterfacesRules.hs" #-} + )) of + { !_intersOinfo -> + (case (({-# LINE 85 "InterfacesRules.lag" #-} + snd (bounds _lhsItdp) + 1 + {-# LINE 140 "InterfacesRules.hs" #-} + )) of + { !_intersOv -> + (case (inters_ _intersOinfo _intersOv ) of + { ( !_intersIdescr,!_intersIfirstvisitvertices,!_intersInewedges,!_intersIv,!T_Interfaces_1 inters_1) -> + (case (({-# LINE 260 "InterfacesRules.lag" #-} + let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ] + in _intersIfirstvisitvertices ++ terminals + {-# LINE 148 "InterfacesRules.hs" #-} + )) of + { !_intersOprev -> + (case (({-# LINE 71 "InterfacesRules.lag" #-} + toList _intersInewedges + {-# LINE 153 "InterfacesRules.hs" #-} + )) of + { !_newedges -> + (case (({-# LINE 72 "InterfacesRules.lag" #-} + let graph = buildG (0,_intersIv-1) es + es = _newedges ++ edges _lhsItdp + in transposeG graph + {-# LINE 160 "InterfacesRules.hs" #-} + )) of + { !_visitssGraph -> + (case (({-# LINE 218 "InterfacesRules.lag" #-} + _visitssGraph + {-# LINE 165 "InterfacesRules.hs" #-} + )) of + { !_intersOvssGraph -> + (case (({-# LINE 147 "InterfacesRules.lag" #-} + toList _intersIdescr + {-# LINE 170 "InterfacesRules.hs" #-} + )) of + { !_descr -> + (case (({-# LINE 127 "InterfacesRules.lag" #-} + Map.fromList _descr + {-# LINE 175 "InterfacesRules.hs" #-} + )) of + { !_intersOvisitDescr -> + (case (inters_1 _intersOprev _intersOvisitDescr _intersOvssGraph ) of + { ( !_intersIinters,!T_Interfaces_2 inters_2) -> + (case (({-# LINE 380 "InterfacesRules.lag" #-} + _intersIinters + {-# LINE 182 "InterfacesRules.hs" #-} + )) of + { !_intersOallInters -> + (case (({-# LINE 343 "InterfacesRules.lag" #-} + buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges)) + {-# LINE 187 "InterfacesRules.hs" #-} + )) of + { !_intersOddp -> + (case (inters_2 _intersOallInters _intersOddp ) of + { ( !_intersIedp,!_intersIvisits) -> + (case (({-# LINE 442 "InterfacesRules.lag" #-} + toList _intersIedp + {-# LINE 194 "InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 382 "InterfacesRules.lag" #-} + _intersIinters + {-# LINE 199 "InterfacesRules.hs" #-} + )) of + { !_lhsOinters -> + (case (({-# LINE 383 "InterfacesRules.lag" #-} + _intersIvisits + {-# LINE 204 "InterfacesRules.hs" #-} + )) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOinters,_lhsOvisits) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Interface --------------------------------------------------- +{- + visit 0: + inherited attribute: + info : Info + chained attribute: + v : Vertex + synthesized attributes: + descr : Seq (Vertex,ChildVisit) + firstvisitvertices : [Vertex] + newedges : Seq Edge + visit 1: + inherited attributes: + prev : [Vertex] + visitDescr : Map Vertex ChildVisit + vssGraph : Graph + synthesized attributes: + inter : CInterface + nt : NontermIdent + visit 2: + inherited attributes: + allInters : CInterfaceMap + ddp : Graph + synthesized attributes: + edp : Seq Edge + visits : Map ConstructorIdent CVisits + alternatives: + alternative Interface: + child nt : {NontermIdent} + child cons : {[ConstructorIdent]} + child seg : Segments + visit 0: + local look : {Vertex -> CRule} + local v : _ + local firstvisitvertices : _ + local descr : _ + local newedges : _ +-} +-- cata +sem_Interface :: Interface -> + T_Interface +sem_Interface !(Interface _nt _cons _seg ) = + (sem_Interface_Interface _nt _cons (sem_Segments _seg ) ) +-- semantic domain +newtype T_Interface = T_Interface (Info -> + Vertex -> + ( (Seq (Vertex,ChildVisit)),([Vertex]),(Seq Edge ),Vertex,T_Interface_1 )) +newtype T_Interface_1 = T_Interface_1 (([Vertex]) -> + (Map Vertex ChildVisit) -> + Graph -> + ( CInterface,NontermIdent,T_Interface_2 )) +newtype T_Interface_2 = T_Interface_2 (CInterfaceMap -> + Graph -> + ( (Seq Edge),(Map ConstructorIdent CVisits))) +data Inh_Interface = Inh_Interface {allInters_Inh_Interface :: !(CInterfaceMap),ddp_Inh_Interface :: !(Graph),info_Inh_Interface :: !(Info),prev_Inh_Interface :: !(([Vertex])),v_Inh_Interface :: !(Vertex),visitDescr_Inh_Interface :: !((Map Vertex ChildVisit)),vssGraph_Inh_Interface :: !(Graph)} +data Syn_Interface = Syn_Interface {descr_Syn_Interface :: !((Seq (Vertex,ChildVisit))),edp_Syn_Interface :: !((Seq Edge)),firstvisitvertices_Syn_Interface :: !(([Vertex])),inter_Syn_Interface :: !(CInterface),newedges_Syn_Interface :: !((Seq Edge )),nt_Syn_Interface :: !(NontermIdent),v_Syn_Interface :: !(Vertex),visits_Syn_Interface :: !((Map ConstructorIdent CVisits))} +wrap_Interface :: T_Interface -> + Inh_Interface -> + Syn_Interface +wrap_Interface !(T_Interface sem ) !(Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = + (let ( !_lhsOdescr,!_lhsOfirstvisitvertices,!_lhsOnewedges,!_lhsOv,!T_Interface_1 sem_1) = sem _lhsIinfo _lhsIv + ( !_lhsOinter,!_lhsOnt,!T_Interface_2 sem_2) = sem_1 _lhsIprev _lhsIvisitDescr _lhsIvssGraph + ( !_lhsOedp,!_lhsOvisits) = sem_2 _lhsIallInters _lhsIddp + in (Syn_Interface _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits )) +sem_Interface_Interface :: NontermIdent -> + ([ConstructorIdent]) -> + T_Segments -> + T_Interface +sem_Interface_Interface !nt_ !cons_ !(T_Segments seg_ ) = + (T_Interface (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (({-# LINE 83 "InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 281 "InterfacesRules.hs" #-} + )) of + { !_segOinfo -> + (case (({-# LINE 205 "InterfacesRules.lag" #-} + 0 + {-# LINE 286 "InterfacesRules.hs" #-} + )) of + { !_segOn -> + (case (({-# LINE 195 "InterfacesRules.lag" #-} + \a -> ruleTable _lhsIinfo ! a + {-# LINE 291 "InterfacesRules.hs" #-} + )) of + { !_look -> + (case (({-# LINE 187 "InterfacesRules.lag" #-} + _lhsIv + {-# LINE 296 "InterfacesRules.hs" #-} + )) of + { !_segOv -> + (case (seg_ _segOinfo _segOn _segOv ) of + { ( !_segIdescr,!_segIgroups,!_segInewedges,!_segInewvertices,!_segIv,!T_Segments_1 seg_1) -> + (case (({-# LINE 188 "InterfacesRules.lag" #-} + _segIv + length _segInewvertices + {-# LINE 303 "InterfacesRules.hs" #-} + )) of + { !_v -> + (case (({-# LINE 190 "InterfacesRules.lag" #-} + [_segIv .. _v-1] + {-# LINE 308 "InterfacesRules.hs" #-} + )) of + { !_firstvisitvertices -> + (case (({-# LINE 196 "InterfacesRules.lag" #-} + zipWith (cv _look (-1)) _firstvisitvertices _segIgroups + {-# LINE 313 "InterfacesRules.hs" #-} + )) of + { !_descr -> + (case (({-# LINE 197 "InterfacesRules.lag" #-} + _segIdescr Seq.>< Seq.fromList _descr + {-# LINE 318 "InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 258 "InterfacesRules.lag" #-} + _firstvisitvertices + {-# LINE 323 "InterfacesRules.hs" #-} + )) of + { !_lhsOfirstvisitvertices -> + (case (({-# LINE 191 "InterfacesRules.lag" #-} + zip _firstvisitvertices _segInewvertices + {-# LINE 328 "InterfacesRules.hs" #-} + )) of + { !_newedges -> + (case (({-# LINE 192 "InterfacesRules.lag" #-} + _segInewedges Seq.>< Seq.fromList _newedges + {-# LINE 333 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 189 "InterfacesRules.lag" #-} + _v + {-# LINE 338 "InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Interface_Interface_1 :: T_Interface_1 + sem_Interface_Interface_1 = + (T_Interface_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 216 "InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 348 "InterfacesRules.hs" #-} + )) of + { !_segOvssGraph -> + (case (({-# LINE 125 "InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 353 "InterfacesRules.hs" #-} + )) of + { !_segOvisitDescr -> + (case (({-# LINE 263 "InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 358 "InterfacesRules.hs" #-} + )) of + { !_segOprev -> + (case (({-# LINE 237 "InterfacesRules.lag" #-} + cons_ + {-# LINE 363 "InterfacesRules.hs" #-} + )) of + { !_segOcons -> + (case (seg_1 _segOcons _segOprev _segOvisitDescr _segOvssGraph ) of + { ( !_segIsegs,!T_Segments_2 seg_2) -> + (case (({-# LINE 395 "InterfacesRules.lag" #-} + CInterface _segIsegs + {-# LINE 370 "InterfacesRules.hs" #-} + )) of + { !_lhsOinter -> + (case (({-# LINE 391 "InterfacesRules.lag" #-} + nt_ + {-# LINE 375 "InterfacesRules.hs" #-} + )) of + { !_lhsOnt -> + (case ((let sem_Interface_Interface_2 :: T_Interface_2 + sem_Interface_Interface_2 = + (T_Interface_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (({-# LINE 341 "InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 384 "InterfacesRules.hs" #-} + )) of + { !_segOddp -> + (case (({-# LINE 378 "InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 389 "InterfacesRules.hs" #-} + )) of + { !_segOallInters -> + (case (({-# LINE 351 "InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 394 "InterfacesRules.hs" #-} + )) of + { !_segOfromLhs -> + (case (({-# LINE 314 "InterfacesRules.lag" #-} + True + {-# LINE 399 "InterfacesRules.hs" #-} + )) of + { !_segOisFirst -> + (case (seg_2 _segOallInters _segOddp _segOfromLhs _segOisFirst ) of + { ( !_segIcvisits,!_segIedp,!_segIfirstInh,!_segIhdIntravisits,!_segIprev) -> + (case (({-# LINE 437 "InterfacesRules.lag" #-} + _segIedp + {-# LINE 406 "InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 396 "InterfacesRules.lag" #-} + Map.fromList (zip cons_ (transpose _segIcvisits)) + {-# LINE 411 "InterfacesRules.hs" #-} + )) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) })) ) + in sem_Interface_Interface_2)) of + { ( !sem_Interface_2) -> + ( _lhsOinter,_lhsOnt,sem_Interface_2) }) }) }) }) }) }) }) })) ) + in sem_Interface_Interface_1)) of + { ( !sem_Interface_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interface_1) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Interfaces -------------------------------------------------- +{- + visit 0: + inherited attribute: + info : Info + chained attribute: + v : Vertex + synthesized attributes: + descr : Seq (Vertex,ChildVisit) + firstvisitvertices : [Vertex] + newedges : Seq Edge + visit 1: + inherited attributes: + prev : [Vertex] + visitDescr : Map Vertex ChildVisit + vssGraph : Graph + synthesized attribute: + inters : CInterfaceMap + visit 2: + inherited attributes: + allInters : CInterfaceMap + ddp : Graph + synthesized attributes: + edp : Seq Edge + visits : CVisitsMap + alternatives: + alternative Cons: + child hd : Interface + child tl : Interfaces + alternative Nil: +-} +-- cata +sem_Interfaces :: Interfaces -> + T_Interfaces +sem_Interfaces !list = + (Prelude.foldr sem_Interfaces_Cons sem_Interfaces_Nil (Prelude.map sem_Interface list) ) +-- semantic domain +newtype T_Interfaces = T_Interfaces (Info -> + Vertex -> + ( (Seq (Vertex,ChildVisit)),([Vertex]),(Seq Edge ),Vertex,T_Interfaces_1 )) +newtype T_Interfaces_1 = T_Interfaces_1 (([Vertex]) -> + (Map Vertex ChildVisit) -> + Graph -> + ( CInterfaceMap,T_Interfaces_2 )) +newtype T_Interfaces_2 = T_Interfaces_2 (CInterfaceMap -> + Graph -> + ( (Seq Edge),CVisitsMap)) +data Inh_Interfaces = Inh_Interfaces {allInters_Inh_Interfaces :: !(CInterfaceMap),ddp_Inh_Interfaces :: !(Graph),info_Inh_Interfaces :: !(Info),prev_Inh_Interfaces :: !(([Vertex])),v_Inh_Interfaces :: !(Vertex),visitDescr_Inh_Interfaces :: !((Map Vertex ChildVisit)),vssGraph_Inh_Interfaces :: !(Graph)} +data Syn_Interfaces = Syn_Interfaces {descr_Syn_Interfaces :: !((Seq (Vertex,ChildVisit))),edp_Syn_Interfaces :: !((Seq Edge)),firstvisitvertices_Syn_Interfaces :: !(([Vertex])),inters_Syn_Interfaces :: !(CInterfaceMap),newedges_Syn_Interfaces :: !((Seq Edge )),v_Syn_Interfaces :: !(Vertex),visits_Syn_Interfaces :: !(CVisitsMap)} +wrap_Interfaces :: T_Interfaces -> + Inh_Interfaces -> + Syn_Interfaces +wrap_Interfaces !(T_Interfaces sem ) !(Inh_Interfaces _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = + (let ( !_lhsOdescr,!_lhsOfirstvisitvertices,!_lhsOnewedges,!_lhsOv,!T_Interfaces_1 sem_1) = sem _lhsIinfo _lhsIv + ( !_lhsOinters,!T_Interfaces_2 sem_2) = sem_1 _lhsIprev _lhsIvisitDescr _lhsIvssGraph + ( !_lhsOedp,!_lhsOvisits) = sem_2 _lhsIallInters _lhsIddp + in (Syn_Interfaces _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits )) +sem_Interfaces_Cons :: T_Interface -> + T_Interfaces -> + T_Interfaces +sem_Interfaces_Cons !(T_Interface hd_ ) !(T_Interfaces tl_ ) = + (T_Interfaces (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _lhsIv + {-# LINE 486 "InterfacesRules.hs" #-} + )) of + { !_hdOv -> + (case (({-# LINE 83 "InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 491 "InterfacesRules.hs" #-} + )) of + { !_hdOinfo -> + (case (hd_ _hdOinfo _hdOv ) of + { ( !_hdIdescr,!_hdIfirstvisitvertices,!_hdInewedges,!_hdIv,!T_Interface_1 hd_1) -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _hdIv + {-# LINE 498 "InterfacesRules.hs" #-} + )) of + { !_tlOv -> + (case (({-# LINE 83 "InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 503 "InterfacesRules.hs" #-} + )) of + { !_tlOinfo -> + (case (tl_ _tlOinfo _tlOv ) of + { ( !_tlIdescr,!_tlIfirstvisitvertices,!_tlInewedges,!_tlIv,!T_Interfaces_1 tl_1) -> + (case (({-# LINE 130 "InterfacesRules.lag" #-} + _hdIdescr Seq.>< _tlIdescr + {-# LINE 510 "InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 258 "InterfacesRules.lag" #-} + _hdIfirstvisitvertices ++ _tlIfirstvisitvertices + {-# LINE 515 "InterfacesRules.hs" #-} + )) of + { !_lhsOfirstvisitvertices -> + (case (({-# LINE 129 "InterfacesRules.lag" #-} + _hdInewedges Seq.>< _tlInewedges + {-# LINE 520 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _tlIv + {-# LINE 525 "InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Interfaces_Cons_1 :: T_Interfaces_1 + sem_Interfaces_Cons_1 = + (T_Interfaces_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 216 "InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 535 "InterfacesRules.hs" #-} + )) of + { !_tlOvssGraph -> + (case (({-# LINE 125 "InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 540 "InterfacesRules.hs" #-} + )) of + { !_tlOvisitDescr -> + (case (({-# LINE 258 "InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 545 "InterfacesRules.hs" #-} + )) of + { !_tlOprev -> + (case (({-# LINE 216 "InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 550 "InterfacesRules.hs" #-} + )) of + { !_hdOvssGraph -> + (case (({-# LINE 125 "InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 555 "InterfacesRules.hs" #-} + )) of + { !_hdOvisitDescr -> + (case (({-# LINE 258 "InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 560 "InterfacesRules.hs" #-} + )) of + { !_hdOprev -> + (case (tl_1 _tlOprev _tlOvisitDescr _tlOvssGraph ) of + { ( !_tlIinters,!T_Interfaces_2 tl_2) -> + (case (hd_1 _hdOprev _hdOvisitDescr _hdOvssGraph ) of + { ( !_hdIinter,!_hdInt,!T_Interface_2 hd_2) -> + (case (({-# LINE 385 "InterfacesRules.lag" #-} + Map.insert _hdInt _hdIinter _tlIinters + {-# LINE 569 "InterfacesRules.hs" #-} + )) of + { !_lhsOinters -> + (case ((let sem_Interfaces_Cons_2 :: T_Interfaces_2 + sem_Interfaces_Cons_2 = + (T_Interfaces_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (({-# LINE 341 "InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 578 "InterfacesRules.hs" #-} + )) of + { !_tlOddp -> + (case (({-# LINE 378 "InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 583 "InterfacesRules.hs" #-} + )) of + { !_tlOallInters -> + (case (tl_2 _tlOallInters _tlOddp ) of + { ( !_tlIedp,!_tlIvisits) -> + (case (({-# LINE 341 "InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 590 "InterfacesRules.hs" #-} + )) of + { !_hdOddp -> + (case (({-# LINE 378 "InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 595 "InterfacesRules.hs" #-} + )) of + { !_hdOallInters -> + (case (hd_2 _hdOallInters _hdOddp ) of + { ( !_hdIedp,!_hdIvisits) -> + (case (({-# LINE 437 "InterfacesRules.lag" #-} + _hdIedp Seq.>< _tlIedp + {-# LINE 602 "InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 386 "InterfacesRules.lag" #-} + Map.insert _hdInt _hdIvisits _tlIvisits + {-# LINE 607 "InterfacesRules.hs" #-} + )) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) }) })) ) + in sem_Interfaces_Cons_2)) of + { ( !sem_Interfaces_2) -> + ( _lhsOinters,sem_Interfaces_2) }) }) }) }) }) }) }) }) }) })) ) + in sem_Interfaces_Cons_1)) of + { ( !sem_Interfaces_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Interfaces_Nil :: T_Interfaces +sem_Interfaces_Nil = + (T_Interfaces (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (({-# LINE 130 "InterfacesRules.lag" #-} + Seq.empty + {-# LINE 623 "InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 258 "InterfacesRules.lag" #-} + [] + {-# LINE 628 "InterfacesRules.hs" #-} + )) of + { !_lhsOfirstvisitvertices -> + (case (({-# LINE 129 "InterfacesRules.lag" #-} + Seq.empty + {-# LINE 633 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _lhsIv + {-# LINE 638 "InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Interfaces_Nil_1 :: T_Interfaces_1 + sem_Interfaces_Nil_1 = + (T_Interfaces_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 387 "InterfacesRules.lag" #-} + Map.empty + {-# LINE 648 "InterfacesRules.hs" #-} + )) of + { !_lhsOinters -> + (case ((let sem_Interfaces_Nil_2 :: T_Interfaces_2 + sem_Interfaces_Nil_2 = + (T_Interfaces_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (({-# LINE 437 "InterfacesRules.lag" #-} + Seq.empty + {-# LINE 657 "InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 388 "InterfacesRules.lag" #-} + Map.empty + {-# LINE 662 "InterfacesRules.hs" #-} + )) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) })) ) + in sem_Interfaces_Nil_2)) of + { ( !sem_Interfaces_2) -> + ( _lhsOinters,sem_Interfaces_2) }) })) ) + in sem_Interfaces_Nil_1)) of + { ( !sem_Interfaces_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) })) ) +-- Segment ----------------------------------------------------- +{- + visit 0: + inherited attribute: + info : Info + chained attribute: + v : Vertex + visit 1: + inherited attributes: + n : Int + nextNewvertices : [Vertex] + synthesized attributes: + descr : Seq (Vertex,ChildVisit) + groups : [([Vertex],[Vertex])] + newedges : Seq Edge + newvertices : [Vertex] + visit 2: + inherited attributes: + cons : [ConstructorIdent] + visitDescr : Map Vertex ChildVisit + vssGraph : Graph + chained attribute: + prev : [Vertex] + synthesized attribute: + seg : CSegment + visit 3: + inherited attributes: + allInters : CInterfaceMap + ddp : Graph + fromLhs : [Vertex] + isFirst : Bool + nextInh : [Vertex] + nextIntravisits : [IntraVisit] + synthesized attributes: + cvisits : [CVisit] + edp : Seq Edge + inh : [Vertex] + intravisits : [IntraVisit] + visitss : [VisitSS] + alternatives: + alternative Segment: + child inh : {[Vertex]} + child syn : {[Vertex]} + visit 0: + local look : {Vertex -> CRule} + local occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} + local groups : {[([Vertex],[Vertex])]} + local v : {Int} + visit 1: + local newvertices : _ + local visitedges : _ + local attredges : _ + intra v : {Int} + intra groups : {[([Vertex],[Vertex])]} + intra look : {Vertex -> CRule} + intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} + visit 2: + local synOccur : _ + local vss : _ + local visitss' : _ + local visitss : {[[Vertex]]} + local defined : _ + local _tup1 : {(Map Identifier Type,Map Identifier Type)} + local synmap : {Map Identifier Type} + local inhmap : {Map Identifier Type} + intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} + visit 3: + local computed : _ + local fromLhs : _ + local iv : _ + local intravisits : _ + intra visitss : {[[Vertex]]} + intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} + intra synmap : {Map Identifier Type} + intra inhmap : {Map Identifier Type} +-} +-- cata +sem_Segment :: Segment -> + T_Segment +sem_Segment !(Segment _inh _syn ) = + (sem_Segment_Segment _inh _syn ) +-- semantic domain +newtype T_Segment = T_Segment (Info -> + Vertex -> + ( Vertex,T_Segment_1 )) +newtype T_Segment_1 = T_Segment_1 (Int -> + ([Vertex]) -> + ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),T_Segment_2 )) +newtype T_Segment_2 = T_Segment_2 (([ConstructorIdent]) -> + ([Vertex]) -> + (Map Vertex ChildVisit) -> + Graph -> + ( ([Vertex]),CSegment,T_Segment_3 )) +newtype T_Segment_3 = T_Segment_3 (CInterfaceMap -> + Graph -> + ([Vertex]) -> + Bool -> + ([Vertex]) -> + ([IntraVisit]) -> + ( ([CVisit]),(Seq Edge),([Vertex]),([IntraVisit]),([VisitSS]))) +data Inh_Segment = Inh_Segment {allInters_Inh_Segment :: !(CInterfaceMap),cons_Inh_Segment :: !(([ConstructorIdent])),ddp_Inh_Segment :: !(Graph),fromLhs_Inh_Segment :: !(([Vertex])),info_Inh_Segment :: !(Info),isFirst_Inh_Segment :: !(Bool),n_Inh_Segment :: !(Int),nextInh_Inh_Segment :: !(([Vertex])),nextIntravisits_Inh_Segment :: !(([IntraVisit])),nextNewvertices_Inh_Segment :: !(([Vertex])),prev_Inh_Segment :: !(([Vertex])),v_Inh_Segment :: !(Vertex),visitDescr_Inh_Segment :: !((Map Vertex ChildVisit)),vssGraph_Inh_Segment :: !(Graph)} +data Syn_Segment = Syn_Segment {cvisits_Syn_Segment :: !(([CVisit])),descr_Syn_Segment :: !((Seq (Vertex,ChildVisit))),edp_Syn_Segment :: !((Seq Edge)),groups_Syn_Segment :: !(([([Vertex],[Vertex])])),inh_Syn_Segment :: !(([Vertex])),intravisits_Syn_Segment :: !(([IntraVisit])),newedges_Syn_Segment :: !((Seq Edge )),newvertices_Syn_Segment :: !(([Vertex])),prev_Syn_Segment :: !(([Vertex])),seg_Syn_Segment :: !(CSegment),v_Syn_Segment :: !(Vertex),visitss_Syn_Segment :: !(([VisitSS]))} +wrap_Segment :: T_Segment -> + Inh_Segment -> + Syn_Segment +wrap_Segment !(T_Segment sem ) !(Inh_Segment _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = + (let ( !_lhsOv,!T_Segment_1 sem_1) = sem _lhsIinfo _lhsIv + ( !_lhsOdescr,!_lhsOgroups,!_lhsOnewedges,!_lhsOnewvertices,!T_Segment_2 sem_2) = sem_1 _lhsIn _lhsInextNewvertices + ( !_lhsOprev,!_lhsOseg,!T_Segment_3 sem_3) = sem_2 _lhsIcons _lhsIprev _lhsIvisitDescr _lhsIvssGraph + ( !_lhsOcvisits,!_lhsOedp,!_lhsOinh,!_lhsOintravisits,!_lhsOvisitss) = sem_3 _lhsIallInters _lhsIddp _lhsIfromLhs _lhsIisFirst _lhsInextInh _lhsInextIntravisits + in (Syn_Segment _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss )) +sem_Segment_Segment :: ([Vertex]) -> + ([Vertex]) -> + T_Segment +sem_Segment_Segment !inh_ !syn_ = + (T_Segment (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (({-# LINE 106 "InterfacesRules.lag" #-} + \a -> ruleTable _lhsIinfo ! a + {-# LINE 791 "InterfacesRules.hs" #-} + )) of + { !_look -> + (case (({-# LINE 109 "InterfacesRules.lag" #-} + \p us -> [ a | u <- us + , a <- tdsToTdp _lhsIinfo ! u + , p (_look a)] + {-# LINE 798 "InterfacesRules.hs" #-} + )) of + { !_occurAs -> + (case (({-# LINE 113 "InterfacesRules.lag" #-} + let group as = gather _lhsIinfo (_occurAs isRhs as) + in map (partition (isInh . _look)) (group (inh_ ++ syn_)) + {-# LINE 804 "InterfacesRules.hs" #-} + )) of + { !_groups -> + (case (({-# LINE 116 "InterfacesRules.lag" #-} + _lhsIv + length _groups + {-# LINE 809 "InterfacesRules.hs" #-} + )) of + { !_v -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _v + {-# LINE 814 "InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Segment_Segment_1 :: T_Segment_1 + sem_Segment_Segment_1 = + (T_Segment_1 (\ (!_lhsIn) + (!_lhsInextNewvertices) -> + (case (({-# LINE 117 "InterfacesRules.lag" #-} + [_lhsIv .. _v -1] + {-# LINE 823 "InterfacesRules.hs" #-} + )) of + { !_newvertices -> + (case (({-# LINE 132 "InterfacesRules.lag" #-} + Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups + {-# LINE 828 "InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 182 "InterfacesRules.lag" #-} + _groups + {-# LINE 833 "InterfacesRules.hs" #-} + )) of + { !_lhsOgroups -> + (case (({-# LINE 174 "InterfacesRules.lag" #-} + zip _newvertices _lhsInextNewvertices + {-# LINE 838 "InterfacesRules.hs" #-} + )) of + { !_visitedges -> + (case (({-# LINE 155 "InterfacesRules.lag" #-} + concat (zipWith ed _newvertices _groups) + {-# LINE 843 "InterfacesRules.hs" #-} + )) of + { !_attredges -> + (case (({-# LINE 175 "InterfacesRules.lag" #-} + Seq.fromList _attredges Seq.>< Seq.fromList _visitedges + {-# LINE 848 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 166 "InterfacesRules.lag" #-} + _newvertices + {-# LINE 853 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewvertices -> + (case ((let sem_Segment_Segment_2 :: T_Segment_2 + sem_Segment_Segment_2 = + (T_Segment_2 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 229 "InterfacesRules.lag" #-} + gather _lhsIinfo (_occurAs isLhs syn_) + {-# LINE 864 "InterfacesRules.hs" #-} + )) of + { !_synOccur -> + (case (({-# LINE 230 "InterfacesRules.lag" #-} + let hasCode v | inRange (bounds (ruleTable _lhsIinfo)) v = getHasCode (ruleTable _lhsIinfo ! v) + | otherwise = True + in if null syn_ + then replicate (length _lhsIcons) [] + else map (filter hasCode . topSort' _lhsIvssGraph) _synOccur + {-# LINE 873 "InterfacesRules.hs" #-} + )) of + { !_vss -> + (case (({-# LINE 270 "InterfacesRules.lag" #-} + map (\\ _lhsIprev) _vss + {-# LINE 878 "InterfacesRules.hs" #-} + )) of + { !_visitss' -> + (case (({-# LINE 284 "InterfacesRules.lag" #-} + let rem :: [(Identifier,Identifier,Maybe Type)] -> [Vertex] -> [Vertex] + rem prev [] = [] + rem prev (v:vs) + | inRange (bounds table) v + = let cr = table ! v + addV = case findIndex cmp prev of + Just _ -> id + _ -> (v:) + cmp (fld,attr,tp) = getField cr == fld && getAttr cr == attr && sameNT (getType cr) tp + sameNT (Just (NT ntA _)) (Just (NT ntB _)) = ntA == ntB + sameNT _ _ = False + def = Map.elems (getDefines cr) + in addV (rem (def ++ prev) vs) + | otherwise = v:rem prev vs + table = ruleTable _lhsIinfo + in map (rem []) _visitss' + {-# LINE 898 "InterfacesRules.hs" #-} + )) of + { !_visitss -> + (case (({-# LINE 271 "InterfacesRules.lag" #-} + let defines v = case Map.lookup v _lhsIvisitDescr of + Nothing -> [v] + Just (ChildVisit _ _ _ inh _) -> v:inh + in concatMap (concatMap defines) _visitss + {-# LINE 906 "InterfacesRules.hs" #-} + )) of + { !_defined -> + (case (({-# LINE 275 "InterfacesRules.lag" #-} + _lhsIprev ++ _defined + {-# LINE 911 "InterfacesRules.hs" #-} + )) of + { !_lhsOprev -> + (case (({-# LINE 409 "InterfacesRules.lag" #-} + let makemap = Map.fromList . map findType + findType v = getNtaNameType (attrTable _lhsIinfo ! v) + in (makemap inh_,makemap syn_) + {-# LINE 918 "InterfacesRules.hs" #-} + )) of + { !__tup1 -> + (case (({-# LINE 409 "InterfacesRules.lag" #-} + __tup1 + {-# LINE 923 "InterfacesRules.hs" #-} + )) of + { !(_,!_synmap) -> + (case (({-# LINE 409 "InterfacesRules.lag" #-} + __tup1 + {-# LINE 928 "InterfacesRules.hs" #-} + )) of + { !(!_inhmap,_) -> + (case (({-# LINE 405 "InterfacesRules.lag" #-} + if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap + {-# LINE 933 "InterfacesRules.hs" #-} + )) of + { !_lhsOseg -> + (case ((let sem_Segment_Segment_3 :: T_Segment_3 + sem_Segment_Segment_3 = + (T_Segment_3 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) + (!_lhsInextInh) + (!_lhsInextIntravisits) -> + (case (({-# LINE 357 "InterfacesRules.lag" #-} + let computes v = case Map.lookup v _lhsIvisitDescr of + Nothing -> Map.keys (getDefines (ruleTable _lhsIinfo ! v)) + Just (ChildVisit _ _ _ _ syn) -> v:syn + in concatMap (concatMap computes) _visitss + {-# LINE 949 "InterfacesRules.hs" #-} + )) of + { !_computed -> + (case (({-# LINE 356 "InterfacesRules.lag" #-} + _occurAs isLhs inh_ ++ _lhsIfromLhs + {-# LINE 954 "InterfacesRules.hs" #-} + )) of + { !_fromLhs -> + (case (({-# LINE 362 "InterfacesRules.lag" #-} + \vs next -> + let needed = concatMap (_lhsIddp !) vs + in nub (needed ++ next) \\ (_fromLhs ++ _computed) + {-# LINE 961 "InterfacesRules.hs" #-} + )) of + { !_iv -> + (case (({-# LINE 361 "InterfacesRules.lag" #-} + zipWith _iv _visitss _lhsInextIntravisits + {-# LINE 966 "InterfacesRules.hs" #-} + )) of + { !_intravisits -> + (case (({-# LINE 412 "InterfacesRules.lag" #-} + let mkVisit vss intra = CVisit _inhmap _synmap (mkSequence vss) (mkSequence intra) True + mkSequence = map mkRule + mkRule v = case Map.lookup v _lhsIvisitDescr of + Nothing -> ruleTable _lhsIinfo ! v + Just (ChildVisit name nt n _ _) -> ccv name nt n _lhsIallInters + in zipWith mkVisit _visitss _intravisits + {-# LINE 976 "InterfacesRules.hs" #-} + )) of + { !_lhsOcvisits -> + (case (({-# LINE 439 "InterfacesRules.lag" #-} + Seq.fromList [(i,s) | i <- inh_, s <- syn_] + Seq.>< Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ] + {-# LINE 982 "InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 444 "InterfacesRules.lag" #-} + inh_ + {-# LINE 987 "InterfacesRules.hs" #-} + )) of + { !_lhsOinh -> + (case (({-# LINE 327 "InterfacesRules.lag" #-} + _intravisits + {-# LINE 992 "InterfacesRules.hs" #-} + )) of + { !_lhsOintravisits -> + (case (({-# LINE 269 "InterfacesRules.lag" #-} + _visitss + {-# LINE 997 "InterfacesRules.hs" #-} + )) of + { !_lhsOvisitss -> + ( _lhsOcvisits,_lhsOedp,_lhsOinh,_lhsOintravisits,_lhsOvisitss) }) }) }) }) }) }) }) }) })) ) + in sem_Segment_Segment_3)) of + { ( !sem_Segment_3) -> + ( _lhsOprev,_lhsOseg,sem_Segment_3) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Segment_Segment_2)) of + { ( !sem_Segment_2) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,sem_Segment_2) }) }) }) }) }) }) }) })) ) + in sem_Segment_Segment_1)) of + { ( !sem_Segment_1) -> + ( _lhsOv,sem_Segment_1) }) }) }) }) }) })) ) +-- Segments ---------------------------------------------------- +{- + visit 0: + inherited attributes: + info : Info + n : Int + chained attribute: + v : Vertex + synthesized attributes: + descr : Seq (Vertex,ChildVisit) + groups : [([Vertex],[Vertex])] + newedges : Seq Edge + newvertices : [Vertex] + visit 1: + inherited attributes: + cons : [ConstructorIdent] + prev : [Vertex] + visitDescr : Map Vertex ChildVisit + vssGraph : Graph + synthesized attribute: + segs : CSegments + visit 2: + inherited attributes: + allInters : CInterfaceMap + ddp : Graph + fromLhs : [Vertex] + isFirst : Bool + synthesized attributes: + cvisits : [[CVisit]] + edp : Seq Edge + firstInh : [Vertex] + hdIntravisits : [IntraVisit] + prev : [Vertex] + alternatives: + alternative Cons: + child hd : Segment + child tl : Segments + alternative Nil: +-} +-- cata +sem_Segments :: Segments -> + T_Segments +sem_Segments !list = + (Prelude.foldr sem_Segments_Cons sem_Segments_Nil (Prelude.map sem_Segment list) ) +-- semantic domain +newtype T_Segments = T_Segments (Info -> + Int -> + Vertex -> + ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),Vertex,T_Segments_1 )) +newtype T_Segments_1 = T_Segments_1 (([ConstructorIdent]) -> + ([Vertex]) -> + (Map Vertex ChildVisit) -> + Graph -> + ( CSegments,T_Segments_2 )) +newtype T_Segments_2 = T_Segments_2 (CInterfaceMap -> + Graph -> + ([Vertex]) -> + Bool -> + ( ([[CVisit]]),(Seq Edge),([Vertex]),([IntraVisit]),([Vertex]))) +data Inh_Segments = Inh_Segments {allInters_Inh_Segments :: !(CInterfaceMap),cons_Inh_Segments :: !(([ConstructorIdent])),ddp_Inh_Segments :: !(Graph),fromLhs_Inh_Segments :: !(([Vertex])),info_Inh_Segments :: !(Info),isFirst_Inh_Segments :: !(Bool),n_Inh_Segments :: !(Int),prev_Inh_Segments :: !(([Vertex])),v_Inh_Segments :: !(Vertex),visitDescr_Inh_Segments :: !((Map Vertex ChildVisit)),vssGraph_Inh_Segments :: !(Graph)} +data Syn_Segments = Syn_Segments {cvisits_Syn_Segments :: !(([[CVisit]])),descr_Syn_Segments :: !((Seq (Vertex,ChildVisit))),edp_Syn_Segments :: !((Seq Edge)),firstInh_Syn_Segments :: !(([Vertex])),groups_Syn_Segments :: !(([([Vertex],[Vertex])])),hdIntravisits_Syn_Segments :: !(([IntraVisit])),newedges_Syn_Segments :: !((Seq Edge )),newvertices_Syn_Segments :: !(([Vertex])),prev_Syn_Segments :: !(([Vertex])),segs_Syn_Segments :: !(CSegments),v_Syn_Segments :: !(Vertex)} +wrap_Segments :: T_Segments -> + Inh_Segments -> + Syn_Segments +wrap_Segments !(T_Segments sem ) !(Inh_Segments _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = + (let ( !_lhsOdescr,!_lhsOgroups,!_lhsOnewedges,!_lhsOnewvertices,!_lhsOv,!T_Segments_1 sem_1) = sem _lhsIinfo _lhsIn _lhsIv + ( !_lhsOsegs,!T_Segments_2 sem_2) = sem_1 _lhsIcons _lhsIprev _lhsIvisitDescr _lhsIvssGraph + ( !_lhsOcvisits,!_lhsOedp,!_lhsOfirstInh,!_lhsOhdIntravisits,!_lhsOprev) = sem_2 _lhsIallInters _lhsIddp _lhsIfromLhs _lhsIisFirst + in (Syn_Segments _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv )) +sem_Segments_Cons :: T_Segment -> + T_Segments -> + T_Segments +sem_Segments_Cons !(T_Segment hd_ ) !(T_Segments tl_ ) = + (T_Segments (\ (!_lhsIinfo) + (!_lhsIn) + (!_lhsIv) -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _lhsIv + {-# LINE 1088 "InterfacesRules.hs" #-} + )) of + { !_hdOv -> + (case (({-# LINE 83 "InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 1093 "InterfacesRules.hs" #-} + )) of + { !_hdOinfo -> + (case (hd_ _hdOinfo _hdOv ) of + { ( !_hdIv,!T_Segment_1 hd_1) -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _hdIv + {-# LINE 1100 "InterfacesRules.hs" #-} + )) of + { !_tlOv -> + (case (({-# LINE 83 "InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 1105 "InterfacesRules.hs" #-} + )) of + { !_tlOinfo -> + (case (({-# LINE 203 "InterfacesRules.lag" #-} + _lhsIn + {-# LINE 1110 "InterfacesRules.hs" #-} + )) of + { !_hdOn -> + (case (({-# LINE 207 "InterfacesRules.lag" #-} + _lhsIn + 1 + {-# LINE 1115 "InterfacesRules.hs" #-} + )) of + { !_tlOn -> + (case (tl_ _tlOinfo _tlOn _tlOv ) of + { ( !_tlIdescr,!_tlIgroups,!_tlInewedges,!_tlInewvertices,!_tlIv,!T_Segments_1 tl_1) -> + (case (({-# LINE 169 "InterfacesRules.lag" #-} + _tlInewvertices + {-# LINE 1122 "InterfacesRules.hs" #-} + )) of + { !_hdOnextNewvertices -> + (case (hd_1 _hdOn _hdOnextNewvertices ) of + { ( !_hdIdescr,!_hdIgroups,!_hdInewedges,!_hdInewvertices,!T_Segment_2 hd_2) -> + (case (({-# LINE 130 "InterfacesRules.lag" #-} + _hdIdescr Seq.>< _tlIdescr + {-# LINE 1129 "InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 184 "InterfacesRules.lag" #-} + _hdIgroups + {-# LINE 1134 "InterfacesRules.hs" #-} + )) of + { !_lhsOgroups -> + (case (({-# LINE 129 "InterfacesRules.lag" #-} + _hdInewedges Seq.>< _tlInewedges + {-# LINE 1139 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 170 "InterfacesRules.lag" #-} + _hdInewvertices + {-# LINE 1144 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewvertices -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _tlIv + {-# LINE 1149 "InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Segments_Cons_1 :: T_Segments_1 + sem_Segments_Cons_1 = + (T_Segments_1 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 216 "InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 1160 "InterfacesRules.hs" #-} + )) of + { !_tlOvssGraph -> + (case (({-# LINE 125 "InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 1165 "InterfacesRules.hs" #-} + )) of + { !_tlOvisitDescr -> + (case (({-# LINE 216 "InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 1170 "InterfacesRules.hs" #-} + )) of + { !_hdOvssGraph -> + (case (({-# LINE 125 "InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 1175 "InterfacesRules.hs" #-} + )) of + { !_hdOvisitDescr -> + (case (({-# LINE 263 "InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 1180 "InterfacesRules.hs" #-} + )) of + { !_hdOprev -> + (case (({-# LINE 235 "InterfacesRules.lag" #-} + _lhsIcons + {-# LINE 1185 "InterfacesRules.hs" #-} + )) of + { !_hdOcons -> + (case (hd_2 _hdOcons _hdOprev _hdOvisitDescr _hdOvssGraph ) of + { ( !_hdIprev,!_hdIseg,!T_Segment_3 hd_3) -> + (case (({-# LINE 263 "InterfacesRules.lag" #-} + _hdIprev + {-# LINE 1192 "InterfacesRules.hs" #-} + )) of + { !_tlOprev -> + (case (({-# LINE 235 "InterfacesRules.lag" #-} + _lhsIcons + {-# LINE 1197 "InterfacesRules.hs" #-} + )) of + { !_tlOcons -> + (case (tl_1 _tlOcons _tlOprev _tlOvisitDescr _tlOvssGraph ) of + { ( !_tlIsegs,!T_Segments_2 tl_2) -> + (case (({-# LINE 400 "InterfacesRules.lag" #-} + _hdIseg : _tlIsegs + {-# LINE 1204 "InterfacesRules.hs" #-} + )) of + { !_lhsOsegs -> + (case ((let sem_Segments_Cons_2 :: T_Segments_2 + sem_Segments_Cons_2 = + (T_Segments_2 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) -> + (case (({-# LINE 341 "InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 1215 "InterfacesRules.hs" #-} + )) of + { !_tlOddp -> + (case (({-# LINE 378 "InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 1220 "InterfacesRules.hs" #-} + )) of + { !_tlOallInters -> + (case (({-# LINE 341 "InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 1225 "InterfacesRules.hs" #-} + )) of + { !_hdOddp -> + (case (({-# LINE 378 "InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 1230 "InterfacesRules.hs" #-} + )) of + { !_hdOallInters -> + (case (({-# LINE 354 "InterfacesRules.lag" #-} + [] + {-# LINE 1235 "InterfacesRules.hs" #-} + )) of + { !_tlOfromLhs -> + (case (({-# LINE 353 "InterfacesRules.lag" #-} + _lhsIfromLhs + {-# LINE 1240 "InterfacesRules.hs" #-} + )) of + { !_hdOfromLhs -> + (case (({-# LINE 316 "InterfacesRules.lag" #-} + False + {-# LINE 1245 "InterfacesRules.hs" #-} + )) of + { !_tlOisFirst -> + (case (tl_2 _tlOallInters _tlOddp _tlOfromLhs _tlOisFirst ) of + { ( !_tlIcvisits,!_tlIedp,!_tlIfirstInh,!_tlIhdIntravisits,!_tlIprev) -> + (case (({-# LINE 329 "InterfacesRules.lag" #-} + _tlIhdIntravisits + {-# LINE 1252 "InterfacesRules.hs" #-} + )) of + { !_hdOnextIntravisits -> + (case (({-# LINE 312 "InterfacesRules.lag" #-} + _lhsIisFirst + {-# LINE 1257 "InterfacesRules.hs" #-} + )) of + { !_hdOisFirst -> + (case (({-# LINE 446 "InterfacesRules.lag" #-} + _tlIfirstInh + {-# LINE 1262 "InterfacesRules.hs" #-} + )) of + { !_hdOnextInh -> + (case (hd_3 _hdOallInters _hdOddp _hdOfromLhs _hdOisFirst _hdOnextInh _hdOnextIntravisits ) of + { ( !_hdIcvisits,!_hdIedp,!_hdIinh,!_hdIintravisits,!_hdIvisitss) -> + (case (({-# LINE 399 "InterfacesRules.lag" #-} + _hdIcvisits : _tlIcvisits + {-# LINE 1269 "InterfacesRules.hs" #-} + )) of + { !_lhsOcvisits -> + (case (({-# LINE 437 "InterfacesRules.lag" #-} + _hdIedp Seq.>< _tlIedp + {-# LINE 1274 "InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 447 "InterfacesRules.lag" #-} + _hdIinh + {-# LINE 1279 "InterfacesRules.hs" #-} + )) of + { !_lhsOfirstInh -> + (case (({-# LINE 330 "InterfacesRules.lag" #-} + _hdIintravisits + {-# LINE 1284 "InterfacesRules.hs" #-} + )) of + { !_lhsOhdIntravisits -> + (case (({-# LINE 263 "InterfacesRules.lag" #-} + _tlIprev + {-# LINE 1289 "InterfacesRules.hs" #-} + )) of + { !_lhsOprev -> + ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Segments_Cons_2)) of + { ( !sem_Segments_2) -> + ( _lhsOsegs,sem_Segments_2) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Segments_Cons_1)) of + { ( !sem_Segments_1) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Segments_Nil :: T_Segments +sem_Segments_Nil = + (T_Segments (\ (!_lhsIinfo) + (!_lhsIn) + (!_lhsIv) -> + (case (({-# LINE 130 "InterfacesRules.lag" #-} + Seq.empty + {-# LINE 1306 "InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 185 "InterfacesRules.lag" #-} + [] + {-# LINE 1311 "InterfacesRules.hs" #-} + )) of + { !_lhsOgroups -> + (case (({-# LINE 129 "InterfacesRules.lag" #-} + Seq.empty + {-# LINE 1316 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 171 "InterfacesRules.lag" #-} + [] + {-# LINE 1321 "InterfacesRules.hs" #-} + )) of + { !_lhsOnewvertices -> + (case (({-# LINE 82 "InterfacesRules.lag" #-} + _lhsIv + {-# LINE 1326 "InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Segments_Nil_1 :: T_Segments_1 + sem_Segments_Nil_1 = + (T_Segments_1 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 401 "InterfacesRules.lag" #-} + [] + {-# LINE 1337 "InterfacesRules.hs" #-} + )) of + { !_lhsOsegs -> + (case ((let sem_Segments_Nil_2 :: T_Segments_2 + sem_Segments_Nil_2 = + (T_Segments_2 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) -> + (case (({-# LINE 399 "InterfacesRules.lag" #-} + [] + {-# LINE 1348 "InterfacesRules.hs" #-} + )) of + { !_lhsOcvisits -> + (case (({-# LINE 437 "InterfacesRules.lag" #-} + Seq.empty + {-# LINE 1353 "InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 448 "InterfacesRules.lag" #-} + [] + {-# LINE 1358 "InterfacesRules.hs" #-} + )) of + { !_lhsOfirstInh -> + (case (({-# LINE 331 "InterfacesRules.lag" #-} + repeat [] + {-# LINE 1363 "InterfacesRules.hs" #-} + )) of + { !_lhsOhdIntravisits -> + (case (({-# LINE 263 "InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 1368 "InterfacesRules.hs" #-} + )) of + { !_lhsOprev -> + ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) })) ) + in sem_Segments_Nil_2)) of + { ( !sem_Segments_2) -> + ( _lhsOsegs,sem_Segments_2) }) })) ) + in sem_Segments_Nil_1)) of + { ( !sem_Segments_1) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) })) ) diff --git a/src-derived/KWOrder.hs b/src-derived/KWOrder.hs new file mode 100644 --- /dev/null +++ b/src-derived/KWOrder.hs @@ -0,0 +1,1616 @@ + + +-- UUAGC 0.9.38.2 (KWOrder.ag) +module KWOrder where +{-# LINE 6 "KWOrder.ag" #-} + +import AbstractSyntax +import HsToken +import Expression +import Patterns +import Options +import PPUtil +import Pretty +import Knuth1 +import KennedyWarren +import ExecutionPlan +import Data.Maybe +import Debug.Trace +import qualified Data.Set as Set +import qualified Data.Map as Map +{-# LINE 22 "../src-derived/KWOrder.hs" #-} + +{-# LINE 2 "./AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 32 "../src-derived/KWOrder.hs" #-} + +{-# LINE 2 "./HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 38 "../src-derived/KWOrder.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 44 "../src-derived/KWOrder.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 51 "../src-derived/KWOrder.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + echilds : EChild + edges : Set.Set Edge + nontnames : [(Identifier, Identifier)] + vertices : Set.Set Vertex + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} + visit 0: + local vertex : _ + local synvertices : _ + local inhvertices : _ + local edgesout : _ + local edgesin : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _inh _syn _virtual ) = + (sem_Child_Child _name _tp _inh _syn _virtual ) +-- semantic domain +newtype T_Child = T_Child (( EChild,(Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex))) +data Inh_Child = Inh_Child {} +data Syn_Child = Syn_Child {echilds_Syn_Child :: EChild,edges_Syn_Child :: (Set.Set Edge),nontnames_Syn_Child :: ([(Identifier, Identifier)]),vertices_Syn_Child :: (Set.Set Vertex)} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem ) (Inh_Child ) = + (let ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices) = sem + in (Syn_Child _lhsOechilds _lhsOedges _lhsOnontnames _lhsOvertices )) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + (Maybe (Maybe Type)) -> + T_Child +sem_Child_Child name_ tp_ inh_ syn_ virtual_ = + (T_Child (let _lhsOechilds :: EChild + _lhsOvertices :: (Set.Set Vertex) + _lhsOedges :: (Set.Set Edge) + _lhsOnontnames :: ([(Identifier, Identifier)]) + -- "KWOrder.ag"(line 67, column 11) + _lhsOechilds = + ({-# LINE 67 "KWOrder.ag" #-} + EChild name_ tp_ virtual_ + {-# LINE 104 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 100, column 12) + _vertex = + ({-# LINE 100 "KWOrder.ag" #-} + VChild name_ + {-# LINE 110 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 101, column 12) + _synvertices = + ({-# LINE 101 "KWOrder.ag" #-} + map (VAttr Syn name_) . Map.keys $ syn_ + {-# LINE 116 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 102, column 12) + _inhvertices = + ({-# LINE 102 "KWOrder.ag" #-} + map (VAttr Inh name_) . Map.keys $ inh_ + {-# LINE 122 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 103, column 12) + _lhsOvertices = + ({-# LINE 103 "KWOrder.ag" #-} + case tp_ of + NT _ _ -> Set.insert _vertex (Set.fromList $ _synvertices ++ _inhvertices ) + _ -> Set.empty + {-# LINE 130 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 128, column 12) + _edgesout = + ({-# LINE 128 "KWOrder.ag" #-} + [] + {-# LINE 136 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 129, column 12) + _edgesin = + ({-# LINE 129 "KWOrder.ag" #-} + map (flip (,) _vertex ) _synvertices + {-# LINE 142 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 130, column 12) + _lhsOedges = + ({-# LINE 130 "KWOrder.ag" #-} + Set.fromList $ _edgesout ++ _edgesin + {-# LINE 148 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 140, column 12) + _lhsOnontnames = + ({-# LINE 140 "KWOrder.ag" #-} + case tp_ of + NT nont _ -> [(name_, nont)] + _ -> [] + {-# LINE 156 "KWOrder.hs" #-} + ) + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) +-- Children ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + echilds : EChildren + edges : Set.Set Edge + nontnames : [(Identifier, Identifier)] + vertices : Set.Set Vertex + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) +-- semantic domain +newtype T_Children = T_Children (( EChildren,(Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex))) +data Inh_Children = Inh_Children {} +data Syn_Children = Syn_Children {echilds_Syn_Children :: EChildren,edges_Syn_Children :: (Set.Set Edge),nontnames_Syn_Children :: ([(Identifier, Identifier)]),vertices_Syn_Children :: (Set.Set Vertex)} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem ) (Inh_Children ) = + (let ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices) = sem + in (Syn_Children _lhsOechilds _lhsOedges _lhsOnontnames _lhsOvertices )) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = + (T_Children (let _lhsOechilds :: EChildren + _lhsOedges :: (Set.Set Edge) + _lhsOnontnames :: ([(Identifier, Identifier)]) + _lhsOvertices :: (Set.Set Vertex) + _hdIechilds :: EChild + _hdIedges :: (Set.Set Edge) + _hdInontnames :: ([(Identifier, Identifier)]) + _hdIvertices :: (Set.Set Vertex) + _tlIechilds :: EChildren + _tlIedges :: (Set.Set Edge) + _tlInontnames :: ([(Identifier, Identifier)]) + _tlIvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 64, column 29) + _lhsOechilds = + ({-# LINE 64 "KWOrder.ag" #-} + _hdIechilds : _tlIechilds + {-# LINE 208 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 118, column 33) + _lhsOedges = + ({-# LINE 118 "KWOrder.ag" #-} + _hdIedges `Set.union` _tlIedges + {-# LINE 214 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 137, column 37) + _lhsOnontnames = + ({-# LINE 137 "KWOrder.ag" #-} + _hdInontnames ++ _tlInontnames + {-# LINE 220 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + _hdIvertices `Set.union` _tlIvertices + {-# LINE 226 "KWOrder.hs" #-} + ) + ( _hdIechilds,_hdIedges,_hdInontnames,_hdIvertices) = + hd_ + ( _tlIechilds,_tlIedges,_tlInontnames,_tlIvertices) = + tl_ + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (let _lhsOechilds :: EChildren + _lhsOedges :: (Set.Set Edge) + _lhsOnontnames :: ([(Identifier, Identifier)]) + _lhsOvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 64, column 29) + _lhsOechilds = + ({-# LINE 64 "KWOrder.ag" #-} + [] + {-# LINE 243 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 118, column 33) + _lhsOedges = + ({-# LINE 118 "KWOrder.ag" #-} + Set.empty + {-# LINE 249 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 137, column 37) + _lhsOnontnames = + ({-# LINE 137 "KWOrder.ag" #-} + [] + {-# LINE 255 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + Set.empty + {-# LINE 261 "KWOrder.hs" #-} + ) + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + vertices : Set.Set Vertex + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local copy : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = T_Expression (( Expression ,(Set.Set Vertex))) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {copy_Syn_Expression :: Expression ,vertices_Syn_Expression :: (Set.Set Vertex)} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression ) = + (let ( _lhsOcopy,_lhsOvertices) = sem + in (Syn_Expression _lhsOcopy _lhsOvertices )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Expression + -- "KWOrder.ag"(line 87, column 17) + _lhsOvertices = + ({-# LINE 87 "KWOrder.ag" #-} + Set.unions $ map (\tok -> vertices_Syn_HsToken + (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 303 "KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 45 "KWOrder.ag" #-} + Expression pos_ tks_ + {-# LINE 309 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 45 "KWOrder.ag" #-} + _copy + {-# LINE 315 "KWOrder.hs" #-} + ) + in ( _lhsOcopy,_lhsOvertices)) ) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + inhmap : Map.Map NontermIdent Attributes + output : ExecutionPlan + synmap : Map.Map NontermIdent Attributes + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( (Map.Map NontermIdent Attributes),ExecutionPlan,(Map.Map NontermIdent Attributes))) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options} +data Syn_Grammar = Syn_Grammar {inhmap_Syn_Grammar :: (Map.Map NontermIdent Attributes),output_Syn_Grammar :: ExecutionPlan,synmap_Syn_Grammar :: (Map.Map NontermIdent Attributes)} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) = + (let ( _lhsOinhmap,_lhsOoutput,_lhsOsynmap) = sem _lhsIoptions + in (Syn_Grammar _lhsOinhmap _lhsOoutput _lhsOsynmap )) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (\ _lhsIoptions -> + (let _nontsOrulenumber :: Int + _lhsOoutput :: ExecutionPlan + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) + _nontsIdepinfo :: ([NontDependencyInformation]) + _nontsIinhmap :: (Map.Map NontermIdent Attributes) + _nontsIrulenumber :: Int + _nontsIsynmap :: (Map.Map NontermIdent Attributes) + -- "KWOrder.ag"(line 36, column 14) + _nontsOrulenumber = + ({-# LINE 36 "KWOrder.ag" #-} + 0 + {-# LINE 389 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 189, column 15) + (Just _lhsOoutput ) = + ({-# LINE 189 "KWOrder.ag" #-} + kennedyWarrenOrder wrappers_ _nontsIdepinfo typeSyns_ + {-# LINE 395 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 196, column 33) + _lhsOinhmap = + ({-# LINE 196 "KWOrder.ag" #-} + _nontsIinhmap + {-# LINE 401 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 197, column 33) + _lhsOsynmap = + ({-# LINE 197 "KWOrder.ag" #-} + _nontsIsynmap + {-# LINE 407 "KWOrder.hs" #-} + ) + ( _nontsIdepinfo,_nontsIinhmap,_nontsIrulenumber,_nontsIsynmap) = + nonts_ _nontsOrulenumber + in ( _lhsOinhmap,_lhsOoutput,_lhsOsynmap))) ) +-- HsToken ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + vertices : Set.Set Vertex + alternatives: + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGField _field _attr _pos _rdesc ) = + (sem_HsToken_AGField _field _attr _pos _rdesc ) +sem_HsToken (AGLocal _var _pos _rdesc ) = + (sem_HsToken_AGLocal _var _pos _rdesc ) +sem_HsToken (CharToken _value _pos ) = + (sem_HsToken_CharToken _value _pos ) +sem_HsToken (Err _mesg _pos ) = + (sem_HsToken_Err _mesg _pos ) +sem_HsToken (HsToken _value _pos ) = + (sem_HsToken_HsToken _value _pos ) +sem_HsToken (StrToken _value _pos ) = + (sem_HsToken_StrToken _value _pos ) +-- semantic domain +newtype T_HsToken = T_HsToken (( (Set.Set Vertex))) +data Inh_HsToken = Inh_HsToken {} +data Syn_HsToken = Syn_HsToken {vertices_Syn_HsToken :: (Set.Set Vertex)} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem ) (Inh_HsToken ) = + (let ( _lhsOvertices) = sem + in (Syn_HsToken _lhsOvertices )) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- "KWOrder.ag"(line 81, column 14) + _lhsOvertices = + ({-# LINE 81 "KWOrder.ag" #-} + Set.singleton $ VAttr (if field_ == _LHS then Inh + else if field_ == _LOC then Loc + else Syn) field_ attr_ + {-# LINE 478 "KWOrder.hs" #-} + ) + in ( _lhsOvertices)) ) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- "KWOrder.ag"(line 80, column 14) + _lhsOvertices = + ({-# LINE 80 "KWOrder.ag" #-} + Set.singleton $ VAttr Loc _LOC var_ + {-# LINE 491 "KWOrder.hs" #-} + ) + in ( _lhsOvertices)) ) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + Set.empty + {-# LINE 503 "KWOrder.hs" #-} + ) + in ( _lhsOvertices)) ) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + Set.empty + {-# LINE 515 "KWOrder.hs" #-} + ) + in ( _lhsOvertices)) ) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + Set.empty + {-# LINE 527 "KWOrder.hs" #-} + ) + in ( _lhsOvertices)) ) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + Set.empty + {-# LINE 539 "KWOrder.hs" #-} + ) + in ( _lhsOvertices)) ) +-- HsTokens ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) ) +-- semantic domain +newtype T_HsTokens = T_HsTokens (( )) +data Inh_HsTokens = Inh_HsTokens {} +data Syn_HsTokens = Syn_HsTokens {} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens ) = + (let ( ) = sem + in (Syn_HsTokens )) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) = + (T_HsTokens (let _hdIvertices :: (Set.Set Vertex) + ( _hdIvertices) = + hd_ + in ( )) ) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (let + in ( )) ) +-- HsTokensRoot ------------------------------------------------ +{- + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +-- cata +sem_HsTokensRoot :: HsTokensRoot -> + T_HsTokensRoot +sem_HsTokensRoot (HsTokensRoot _tokens ) = + (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens ) ) +-- semantic domain +newtype T_HsTokensRoot = T_HsTokensRoot (( )) +data Inh_HsTokensRoot = Inh_HsTokensRoot {} +data Syn_HsTokensRoot = Syn_HsTokensRoot {} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot ) = + (let ( ) = sem + in (Syn_HsTokensRoot )) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) = + (T_HsTokensRoot (let + in ( )) ) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + chained attribute: + rulenumber : Int + synthesized attributes: + depinfo : NontDependencyInformation + inhmap : Map.Map NontermIdent Attributes + synmap : Map.Map NontermIdent Attributes + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 0: + local synvertices : _ + local inhvertices : _ + local vertices : _ + local nontgraph : _ +-} +-- cata +sem_Nonterminal :: Nonterminal -> + T_Nonterminal +sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods ) = + (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) +-- semantic domain +newtype T_Nonterminal = T_Nonterminal (Int -> + ( NontDependencyInformation,(Map.Map NontermIdent Attributes),Int,(Map.Map NontermIdent Attributes))) +data Inh_Nonterminal = Inh_Nonterminal {rulenumber_Inh_Nonterminal :: Int} +data Syn_Nonterminal = Syn_Nonterminal {depinfo_Syn_Nonterminal :: NontDependencyInformation,inhmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes),rulenumber_Syn_Nonterminal :: Int,synmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes)} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIrulenumber ) = + (let ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap) = sem _lhsIrulenumber + in (Syn_Nonterminal _lhsOdepinfo _lhsOinhmap _lhsOrulenumber _lhsOsynmap )) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = + (T_Nonterminal (\ _lhsIrulenumber -> + (let _lhsOdepinfo :: NontDependencyInformation + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) + _lhsOrulenumber :: Int + _prodsOrulenumber :: Int + _prodsIdepgraph :: ([ProdDependencyGraph]) + _prodsIrulenumber :: Int + -- "KWOrder.ag"(line 162, column 18) + _synvertices = + ({-# LINE 162 "KWOrder.ag" #-} + map (VAttr Syn nt_) . Map.keys $ syn_ + {-# LINE 660 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 163, column 18) + _inhvertices = + ({-# LINE 163 "KWOrder.ag" #-} + map (VAttr Inh nt_) . Map.keys $ inh_ + {-# LINE 666 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 164, column 18) + _vertices = + ({-# LINE 164 "KWOrder.ag" #-} + _synvertices ++ _inhvertices + {-# LINE 672 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 168, column 18) + _nontgraph = + ({-# LINE 168 "KWOrder.ag" #-} + NontDependencyGraph { ndgVertices = _vertices + , ndgEdges = [] } + {-# LINE 679 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 176, column 18) + _lhsOdepinfo = + ({-# LINE 176 "KWOrder.ag" #-} + NontDependencyInformation { ndiNonterminal = nt_ + , ndiParams = params_ + , ndiInh = Map.keys inh_ + , ndiSyn = Map.keys syn_ + , ndiDepGraph = _nontgraph + , ndiProds = _prodsIdepgraph } + {-# LINE 690 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 202, column 17) + _lhsOinhmap = + ({-# LINE 202 "KWOrder.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 696 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 203, column 17) + _lhsOsynmap = + ({-# LINE 203 "KWOrder.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 702 "KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _prodsIrulenumber + {-# LINE 708 "KWOrder.hs" #-} + ) + -- copy rule (down) + _prodsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 714 "KWOrder.hs" #-} + ) + ( _prodsIdepgraph,_prodsIrulenumber) = + prods_ _prodsOrulenumber + in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + chained attribute: + rulenumber : Int + synthesized attributes: + depinfo : [NontDependencyInformation] + inhmap : Map.Map NontermIdent Attributes + synmap : Map.Map NontermIdent Attributes + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals (Int -> + ( ([NontDependencyInformation]),(Map.Map NontermIdent Attributes),Int,(Map.Map NontermIdent Attributes))) +data Inh_Nonterminals = Inh_Nonterminals {rulenumber_Inh_Nonterminals :: Int} +data Syn_Nonterminals = Syn_Nonterminals {depinfo_Syn_Nonterminals :: ([NontDependencyInformation]),inhmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes),rulenumber_Syn_Nonterminals :: Int,synmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes)} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIrulenumber ) = + (let ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap) = sem _lhsIrulenumber + in (Syn_Nonterminals _lhsOdepinfo _lhsOinhmap _lhsOrulenumber _lhsOsynmap )) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = + (T_Nonterminals (\ _lhsIrulenumber -> + (let _lhsOdepinfo :: ([NontDependencyInformation]) + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) + _lhsOrulenumber :: Int + _hdOrulenumber :: Int + _tlOrulenumber :: Int + _hdIdepinfo :: NontDependencyInformation + _hdIinhmap :: (Map.Map NontermIdent Attributes) + _hdIrulenumber :: Int + _hdIsynmap :: (Map.Map NontermIdent Attributes) + _tlIdepinfo :: ([NontDependencyInformation]) + _tlIinhmap :: (Map.Map NontermIdent Attributes) + _tlIrulenumber :: Int + _tlIsynmap :: (Map.Map NontermIdent Attributes) + -- use rule "KWOrder.ag"(line 173, column 33) + _lhsOdepinfo = + ({-# LINE 173 "KWOrder.ag" #-} + _hdIdepinfo : _tlIdepinfo + {-# LINE 773 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 196, column 33) + _lhsOinhmap = + ({-# LINE 196 "KWOrder.ag" #-} + _hdIinhmap `Map.union` _tlIinhmap + {-# LINE 779 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 197, column 33) + _lhsOsynmap = + ({-# LINE 197 "KWOrder.ag" #-} + _hdIsynmap `Map.union` _tlIsynmap + {-# LINE 785 "KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _tlIrulenumber + {-# LINE 791 "KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 797 "KWOrder.hs" #-} + ) + -- copy rule (chain) + _tlOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _hdIrulenumber + {-# LINE 803 "KWOrder.hs" #-} + ) + ( _hdIdepinfo,_hdIinhmap,_hdIrulenumber,_hdIsynmap) = + hd_ _hdOrulenumber + ( _tlIdepinfo,_tlIinhmap,_tlIrulenumber,_tlIsynmap) = + tl_ _tlOrulenumber + in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ _lhsIrulenumber -> + (let _lhsOdepinfo :: ([NontDependencyInformation]) + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) + _lhsOrulenumber :: Int + -- use rule "KWOrder.ag"(line 173, column 33) + _lhsOdepinfo = + ({-# LINE 173 "KWOrder.ag" #-} + [] + {-# LINE 821 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 196, column 33) + _lhsOinhmap = + ({-# LINE 196 "KWOrder.ag" #-} + Map.empty + {-# LINE 827 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 197, column 33) + _lhsOsynmap = + ({-# LINE 197 "KWOrder.ag" #-} + Map.empty + {-# LINE 833 "KWOrder.hs" #-} + ) + -- copy rule (chain) + _lhsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 839 "KWOrder.hs" #-} + ) + in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + vertices : Set.Set Vertex + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local vertex : _ + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern ,(Set.Set Vertex))) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern ,vertices_Syn_Pattern :: (Set.Set Vertex)} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOcopy,_lhsOvertices) = sem + in (Syn_Pattern _lhsOcopy _lhsOvertices )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIvertices :: (Set.Set Vertex) + _partsIcopy :: Patterns + _partsIvertices :: (Set.Set Vertex) + -- "KWOrder.ag"(line 92, column 12) + _vertex = + ({-# LINE 92 "KWOrder.ag" #-} + if field_ == _INST then VChild attr_ + else VAttr (if field_ == _LHS then Syn + else if field_ == _LOC then Loc + else Inh) field_ attr_ + {-# LINE 918 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 96, column 12) + _lhsOvertices = + ({-# LINE 96 "KWOrder.ag" #-} + Set.insert _vertex $ _partsIvertices `Set.union` _patIvertices + {-# LINE 924 "KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 930 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 936 "KWOrder.hs" #-} + ) + ( _patIcopy,_patIvertices) = + pat_ + ( _partsIcopy,_partsIvertices) = + parts_ + in ( _lhsOcopy,_lhsOvertices)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + _patsIvertices + {-# LINE 955 "KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 961 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 967 "KWOrder.hs" #-} + ) + ( _patsIcopy,_patsIvertices) = + pats_ + in ( _lhsOcopy,_lhsOvertices)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + _patIvertices + {-# LINE 983 "KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 989 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 995 "KWOrder.hs" #-} + ) + ( _patIcopy,_patIvertices) = + pat_ + in ( _lhsOcopy,_lhsOvertices)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + _patsIvertices + {-# LINE 1012 "KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1018 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1024 "KWOrder.hs" #-} + ) + ( _patsIcopy,_patsIvertices) = + pats_ + in ( _lhsOcopy,_lhsOvertices)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + Set.empty + {-# LINE 1038 "KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 1044 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1050 "KWOrder.hs" #-} + ) + in ( _lhsOcopy,_lhsOvertices)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + vertices : Set.Set Vertex + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( Patterns ,(Set.Set Vertex))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns ,vertices_Syn_Patterns :: (Set.Set Vertex)} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOcopy,_lhsOvertices) = sem + in (Syn_Patterns _lhsOcopy _lhsOvertices )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIvertices :: (Set.Set Vertex) + _tlIcopy :: Patterns + _tlIvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + _hdIvertices `Set.union` _tlIvertices + {-# LINE 1098 "KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1104 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1110 "KWOrder.hs" #-} + ) + ( _hdIcopy,_hdIvertices) = + hd_ + ( _tlIcopy,_tlIvertices) = + tl_ + in ( _lhsOcopy,_lhsOvertices)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Patterns + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + Set.empty + {-# LINE 1125 "KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 1131 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1137 "KWOrder.hs" #-} + ) + in ( _lhsOcopy,_lhsOvertices)) ) +-- Production -------------------------------------------------- +{- + visit 0: + chained attribute: + rulenumber : Int + synthesized attribute: + depgraph : ProdDependencyGraph + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + visit 0: + local vertices : _ + local edges : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _children _rules _typeSigs ) = + (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) +-- semantic domain +newtype T_Production = T_Production (Int -> + ( ProdDependencyGraph,Int)) +data Inh_Production = Inh_Production {rulenumber_Inh_Production :: Int} +data Syn_Production = Syn_Production {depgraph_Syn_Production :: ProdDependencyGraph,rulenumber_Syn_Production :: Int} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem ) (Inh_Production _lhsIrulenumber ) = + (let ( _lhsOdepgraph,_lhsOrulenumber) = sem _lhsIrulenumber + in (Syn_Production _lhsOdepgraph _lhsOrulenumber )) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = + (T_Production (\ _lhsIrulenumber -> + (let _lhsOdepgraph :: ProdDependencyGraph + _lhsOrulenumber :: Int + _rulesOrulenumber :: Int + _childrenIechilds :: EChildren + _childrenIedges :: (Set.Set Edge) + _childrenInontnames :: ([(Identifier, Identifier)]) + _childrenIvertices :: (Set.Set Vertex) + _rulesIedges :: (Set.Set Edge) + _rulesIerules :: ERules + _rulesIrulenumber :: Int + _rulesIvertices :: (Set.Set Vertex) + -- "KWOrder.ag"(line 114, column 17) + _vertices = + ({-# LINE 114 "KWOrder.ag" #-} + _rulesIvertices `Set.union` _childrenIvertices + {-# LINE 1195 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 134, column 17) + _edges = + ({-# LINE 134 "KWOrder.ag" #-} + _rulesIedges `Set.union` _childrenIedges + {-# LINE 1201 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 149, column 17) + _lhsOdepgraph = + ({-# LINE 149 "KWOrder.ag" #-} + ProdDependencyGraph { pdgVertices = Set.toList _vertices + , pdgEdges = Set.toList _edges + , pdgRules = _rulesIerules + , pdgChilds = _childrenIechilds + , pdgProduction = con_ + , pdgChildMap = _childrenInontnames } + {-# LINE 1212 "KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _rulesIrulenumber + {-# LINE 1218 "KWOrder.hs" #-} + ) + -- copy rule (down) + _rulesOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 1224 "KWOrder.hs" #-} + ) + ( _childrenIechilds,_childrenIedges,_childrenInontnames,_childrenIvertices) = + children_ + ( _rulesIedges,_rulesIerules,_rulesIrulenumber,_rulesIvertices) = + rules_ _rulesOrulenumber + in ( _lhsOdepgraph,_lhsOrulenumber))) ) +-- Productions ------------------------------------------------- +{- + visit 0: + chained attribute: + rulenumber : Int + synthesized attribute: + depgraph : [ProdDependencyGraph] + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) +-- semantic domain +newtype T_Productions = T_Productions (Int -> + ( ([ProdDependencyGraph]),Int)) +data Inh_Productions = Inh_Productions {rulenumber_Inh_Productions :: Int} +data Syn_Productions = Syn_Productions {depgraph_Syn_Productions :: ([ProdDependencyGraph]),rulenumber_Syn_Productions :: Int} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem ) (Inh_Productions _lhsIrulenumber ) = + (let ( _lhsOdepgraph,_lhsOrulenumber) = sem _lhsIrulenumber + in (Syn_Productions _lhsOdepgraph _lhsOrulenumber )) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = + (T_Productions (\ _lhsIrulenumber -> + (let _lhsOdepgraph :: ([ProdDependencyGraph]) + _lhsOrulenumber :: Int + _hdOrulenumber :: Int + _tlOrulenumber :: Int + _hdIdepgraph :: ProdDependencyGraph + _hdIrulenumber :: Int + _tlIdepgraph :: ([ProdDependencyGraph]) + _tlIrulenumber :: Int + -- use rule "KWOrder.ag"(line 146, column 33) + _lhsOdepgraph = + ({-# LINE 146 "KWOrder.ag" #-} + _hdIdepgraph : _tlIdepgraph + {-# LINE 1277 "KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _tlIrulenumber + {-# LINE 1283 "KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 1289 "KWOrder.hs" #-} + ) + -- copy rule (chain) + _tlOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _hdIrulenumber + {-# LINE 1295 "KWOrder.hs" #-} + ) + ( _hdIdepgraph,_hdIrulenumber) = + hd_ _hdOrulenumber + ( _tlIdepgraph,_tlIrulenumber) = + tl_ _tlOrulenumber + in ( _lhsOdepgraph,_lhsOrulenumber))) ) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ _lhsIrulenumber -> + (let _lhsOdepgraph :: ([ProdDependencyGraph]) + _lhsOrulenumber :: Int + -- use rule "KWOrder.ag"(line 146, column 33) + _lhsOdepgraph = + ({-# LINE 146 "KWOrder.ag" #-} + [] + {-# LINE 1311 "KWOrder.hs" #-} + ) + -- copy rule (chain) + _lhsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 1317 "KWOrder.hs" #-} + ) + in ( _lhsOdepgraph,_lhsOrulenumber))) ) +-- Rule -------------------------------------------------------- +{- + visit 0: + chained attribute: + rulenumber : Int + synthesized attributes: + edges : Set.Set Edge + erules : ERule + vertices : Set.Set Vertex + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + visit 0: + local rulename : _ + local vertex : _ + local edgesout : _ + local edgesin : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) +-- semantic domain +newtype T_Rule = T_Rule (Int -> + ( (Set.Set Edge),ERule,Int,(Set.Set Vertex))) +data Inh_Rule = Inh_Rule {rulenumber_Inh_Rule :: Int} +data Syn_Rule = Syn_Rule {edges_Syn_Rule :: (Set.Set Edge),erules_Syn_Rule :: ERule,rulenumber_Syn_Rule :: Int,vertices_Syn_Rule :: (Set.Set Vertex)} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIrulenumber ) = + (let ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber + in (Syn_Rule _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices )) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = + (T_Rule (\ _lhsIrulenumber -> + (let _lhsOrulenumber :: Int + _lhsOerules :: ERule + _lhsOvertices :: (Set.Set Vertex) + _lhsOedges :: (Set.Set Edge) + _patternIcopy :: Pattern + _patternIvertices :: (Set.Set Vertex) + _rhsIcopy :: Expression + _rhsIvertices :: (Set.Set Vertex) + -- "KWOrder.ag"(line 39, column 11) + _lhsOrulenumber = + ({-# LINE 39 "KWOrder.ag" #-} + _lhsIrulenumber + 1 + {-# LINE 1380 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 40, column 11) + _rulename = + ({-# LINE 40 "KWOrder.ag" #-} + maybe (identifier $ "rule" ++ show _lhsIrulenumber) id mbName_ + {-# LINE 1386 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 51, column 10) + _lhsOerules = + ({-# LINE 51 "KWOrder.ag" #-} + ERule _rulename + _patternIcopy + _rhsIcopy + owrt_ + origin_ + explicit_ + {-# LINE 1397 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 109, column 11) + _vertex = + ({-# LINE 109 "KWOrder.ag" #-} + VRule _rulename + {-# LINE 1403 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 110, column 11) + _lhsOvertices = + ({-# LINE 110 "KWOrder.ag" #-} + Set.insert _vertex $ _patternIvertices `Set.union` _rhsIvertices + {-# LINE 1409 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 122, column 11) + _edgesout = + ({-# LINE 122 "KWOrder.ag" #-} + map ((,) _vertex ) (Set.toList _rhsIvertices) + {-# LINE 1415 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 123, column 11) + _edgesin = + ({-# LINE 123 "KWOrder.ag" #-} + map (flip (,) _vertex ) (Set.toList _patternIvertices) + {-# LINE 1421 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 124, column 11) + _lhsOedges = + ({-# LINE 124 "KWOrder.ag" #-} + Set.fromList $ _edgesout ++ _edgesin + {-# LINE 1427 "KWOrder.hs" #-} + ) + ( _patternIcopy,_patternIvertices) = + pattern_ + ( _rhsIcopy,_rhsIvertices) = + rhs_ + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices))) ) +-- Rules ------------------------------------------------------- +{- + visit 0: + chained attribute: + rulenumber : Int + synthesized attributes: + edges : Set.Set Edge + erules : ERules + vertices : Set.Set Vertex + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) +-- semantic domain +newtype T_Rules = T_Rules (Int -> + ( (Set.Set Edge),ERules,Int,(Set.Set Vertex))) +data Inh_Rules = Inh_Rules {rulenumber_Inh_Rules :: Int} +data Syn_Rules = Syn_Rules {edges_Syn_Rules :: (Set.Set Edge),erules_Syn_Rules :: ERules,rulenumber_Syn_Rules :: Int,vertices_Syn_Rules :: (Set.Set Vertex)} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIrulenumber ) = + (let ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber + in (Syn_Rules _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices )) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) = + (T_Rules (\ _lhsIrulenumber -> + (let _lhsOedges :: (Set.Set Edge) + _lhsOerules :: ERules + _lhsOvertices :: (Set.Set Vertex) + _lhsOrulenumber :: Int + _hdOrulenumber :: Int + _tlOrulenumber :: Int + _hdIedges :: (Set.Set Edge) + _hdIerules :: ERule + _hdIrulenumber :: Int + _hdIvertices :: (Set.Set Vertex) + _tlIedges :: (Set.Set Edge) + _tlIerules :: ERules + _tlIrulenumber :: Int + _tlIvertices :: (Set.Set Vertex) + -- use rule "KWOrder.ag"(line 118, column 33) + _lhsOedges = + ({-# LINE 118 "KWOrder.ag" #-} + _hdIedges `Set.union` _tlIedges + {-# LINE 1488 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 48, column 25) + _lhsOerules = + ({-# LINE 48 "KWOrder.ag" #-} + _hdIerules : _tlIerules + {-# LINE 1494 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + _hdIvertices `Set.union` _tlIvertices + {-# LINE 1500 "KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _tlIrulenumber + {-# LINE 1506 "KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 1512 "KWOrder.hs" #-} + ) + -- copy rule (chain) + _tlOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _hdIrulenumber + {-# LINE 1518 "KWOrder.hs" #-} + ) + ( _hdIedges,_hdIerules,_hdIrulenumber,_hdIvertices) = + hd_ _hdOrulenumber + ( _tlIedges,_tlIerules,_tlIrulenumber,_tlIvertices) = + tl_ _tlOrulenumber + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices))) ) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ _lhsIrulenumber -> + (let _lhsOedges :: (Set.Set Edge) + _lhsOerules :: ERules + _lhsOvertices :: (Set.Set Vertex) + _lhsOrulenumber :: Int + -- use rule "KWOrder.ag"(line 118, column 33) + _lhsOedges = + ({-# LINE 118 "KWOrder.ag" #-} + Set.empty + {-# LINE 1536 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 48, column 25) + _lhsOerules = + ({-# LINE 48 "KWOrder.ag" #-} + [] + {-# LINE 1542 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 76, column 36) + _lhsOvertices = + ({-# LINE 76 "KWOrder.ag" #-} + Set.empty + {-# LINE 1548 "KWOrder.hs" #-} + ) + -- copy rule (chain) + _lhsOrulenumber = + ({-# LINE 33 "KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 1554 "KWOrder.hs" #-} + ) + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices))) ) +-- TypeSig ----------------------------------------------------- +{- + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp ) = + (sem_TypeSig_TypeSig _name _tp ) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( )) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) = + (let ( ) = sem + in (Syn_TypeSig )) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let + in ( )) ) +-- TypeSigs ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( )) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) = + (let ( ) = sem + in (Syn_TypeSigs )) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) = + (T_TypeSigs (let + in ( )) ) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let + in ( )) ) diff --git a/src-derived/Order.hs b/src-derived/Order.hs new file mode 100644 --- /dev/null +++ b/src-derived/Order.hs @@ -0,0 +1,5534 @@ + + +-- UUAGC 0.9.38.1 (Order.ag) +module Order where +{-# LINE 9 "Order.ag" #-} + +-- From uuagc +import CommonTypes +import Patterns +import ErrorMessages +import AbstractSyntax +import Code hiding (Type) +import qualified Code +import Expression +import Options +import SequentialComputation +import SequentialTypes +import CodeSyntax +import GrammarInfo +import HsToken(HsTokensRoot(HsTokensRoot)) +import HsTokenScanner(lexTokens) +import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..)) +-- From uulib +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.Sequence as Seq +import Data.Map(Map) +import Data.Set(Set) +import Data.Sequence(Seq, (><)) +import UU.Util.Utils +import UU.Scanner.Position(Pos(..),initPos) +import Data.Foldable(toList) + +-- From haskell libraries +import Control.Monad(liftM) +import qualified Data.Array as Array +import Data.Array((!),bounds,inRange) +import Data.List(elemIndex,partition,sort,mapAccumL,find,nubBy,intersperse,groupBy,transpose) +import qualified Data.Tree as Tree +import Maybe +{-# LINE 42 "../src-derived/Order.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 49 "../src-derived/Order.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 55 "../src-derived/Order.hs" #-} + +{-# LINE 2 "./AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 65 "../src-derived/Order.hs" #-} +{-# LINE 46 "Order.ag" #-} + +-- Terminates with an error if the key is not in the map +findWithErr1 :: (Ord k, Show k) => String -> k -> Map k a -> a +findWithErr1 s k + = Map.findWithDefault (error ("findWithErr1 " ++ s ++ ": key " ++ show k ++ " not in map.")) k + +findWithErr2 :: (Ord k, Show k, Show a) => k -> Map k a -> a +findWithErr2 k m + = Map.findWithDefault (error ("findWithErr2: key " ++ show k ++ " not in map: " ++ show m)) k m +{-# LINE 76 "../src-derived/Order.hs" #-} + +{-# LINE 71 "Order.ag" #-} + +startsWith :: String -> String -> Bool +startsWith k h = k == take (length k) h +{-# LINE 82 "../src-derived/Order.hs" #-} + +{-# LINE 138 "Order.ag" #-} + +getNtName :: Type -> NontermIdent +getNtName (NT nt _) = maybe nt id (deforestedNt nt) +getNtName _ = nullIdent +{-# LINE 89 "../src-derived/Order.hs" #-} + +{-# LINE 166 "Order.ag" #-} + +data AltAttr = AltAttr Identifier Identifier Bool + deriving (Eq, Ord, Show) +{-# LINE 95 "../src-derived/Order.hs" #-} + +{-# LINE 238 "Order.ag" #-} + +substSelf nt tp + = case tp of + NT n tps | n == _SELF -> NT nt tps + _ -> tp + +haskellTupel :: [Type] -> Maybe Type +haskellTupel ts = Just ( Haskell ( '(' : (concat (intersperse "," (map show ts))) ++ ")" )) +{-# LINE 106 "../src-derived/Order.hs" #-} + +{-# LINE 687 "Order.ag" #-} + +swap (a,b) = (b,a) + +showPath :: Table CRule -> [Vertex] -> [String] +showPath ruleTable path + = let look a | inRange (bounds ruleTable) a = [showOrigin (ruleTable ! a)] + | otherwise = ["Vertex " ++ show a] + showOrigin cr | getHasCode cr && getName (getAttr cr) /= "self" = prettyCRule cr ++ " (" ++ show (getPos (getAttr cr)) ++ ")" + | otherwise = prettyCRule cr + in concatMap look path + + +showPathLocal :: Table CRule -> [Vertex] -> [String] +showPathLocal _ [] = [] +showPathLocal ruleTable xs = showP (xs++[-1]) + where showP [] = [] + showP (v1:v2:vs) = let line = step v1 v2 + lines = showP vs + in line:lines + step v1 v2 = " - " ++ a1 + where r1 = ruleTable ! v1 + a1 = show (getAttr r1) + + +limitTo :: Int -> [String] -> [String] +limitTo _ [] = [] +limitTo 0 _ = ["....etcetera, etcetera...."] +limitTo n (x:xs) = x : limitTo (n-1) xs + +showPathNice :: Table CRule -> [Vertex] -> [String] +showPathNice _ [] = [] +showPathNice ruleTable xs = limitTo 100 (showP ((-1):xs++[-1])) + where [maxf, maxa, maxn, maxc] = maxWidths ruleTable (take 100 xs) + showP [] = [] + showP (v1:v2:vs) = let line = step v1 v2 + lines = showP vs + in if null line then lines else line:lines + step v1 v2 | last && first = induced + | last && isSyn r1 = "pass up " ++ alignR maxf "" ++ " " ++ alignL maxa a1 ++ " in " ++ alignR maxn n1 ++ "|" ++ c1 ++ induced + | first&& not(isSyn r2) = "get from above " ++ alignR maxf "" ++ " " ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2 + | last = "pass down " ++ alignR maxf f1 ++ "." ++ a1 ++ induced + | isSyn r2 = "get from below " ++ alignR maxf f2 ++ "." ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2 + | isLocal r1 = if head a1 == '_' + then "" + else "calculate " ++ alignR maxf "loc" ++ "." ++ a1 + | otherwise = "pass down " ++ alignR maxf f1 ++ "." ++ alignL maxa a1 ++ " to " ++ alignR maxn n2 ++ "|" ++ c2 + where + first = v1<0 + last = v2<0 + r1 = ruleTable ! v1 + r2 = ruleTable ! v2 + a1 = show (getAttr r1) + a2 = show (getAttr r2) + f1 = show (getField r1) + f2 = show (getField r2) + n1 = show (getLhsNt r1) + n2 = show (getLhsNt r2) + c1 = show (getCon r1) + c2 = show (getCon r2) + induced | v2== -2 = " INDUCED dependency to " + | otherwise = "" + + +maxWidths ruleTable vs + = map maximum (transpose (map getWidth vs)) + where getWidth v | v<0 = [0,0,0,0] + | otherwise = map (length . show . ($ (ruleTable!v))) [getField, getAttr, getLhsNt, getCon] + +alignL n xs | k Bool -> Route -> Error +localCycleErr ruleTable o_visit (s:path) + = let cr = ruleTable ! s + attr = getAttr cr + nt = getLhsNt cr + con = getCon cr + in LocalCirc nt con attr o_visit (showPathLocal ruleTable path) + +instCycleErr :: Table CRule -> Bool -> Route -> Error +instCycleErr ruleTable o_visit (s:path) + = let cr = ruleTable ! s + attr = getAttr cr + nt = getLhsNt cr + con = getCon cr + in InstCirc nt con attr o_visit (showPathLocal ruleTable path) + +directCycleErrs :: Table NTAttr -> Table CRule -> Bool -> [EdgeRoutes] -> [Error] +directCycleErrs attrTable ruleTable o_visit xs + = let getNont v = case attrTable ! v of + NTASyn nt _ _ -> nt + NTAInh nt _ _ -> nt + getAttr v = case attrTable ! v of + NTASyn _ a _ -> a + NTAInh _ a _ -> a + sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2 + procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2) + wrapGroup gr@(((v1,_),_,_):_) = DirectCirc (getNont v1) o_visit (map procCycle gr) + in map wrapGroup (groupBy sameNont xs) + +inducedCycleErrs :: Table NTAttr -> Table CRule -> CInterfaceMap -> [EdgeRoutes] -> [Error] +inducedCycleErrs attrTable ruleTable cim xs + = let getNont v = case attrTable ! v of + NTASyn nt _ _ -> nt + NTAInh nt _ _ -> nt + getAttr v = case attrTable ! v of + NTASyn _ a _ -> a + NTAInh _ a _ -> a + sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2 + procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2) + wrapGroup gr@(((v1,_),_,_):_) = InducedCirc (getNont v1) (findWithErr1 "inducedCycleErr.cinter" (getNont v1) cim) (map procCycle gr) + in map wrapGroup (groupBy sameNont xs) +{-# LINE 226 "../src-derived/Order.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,Maybe (Maybe Type))] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + inh : Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + o_unbox : Bool + syn : Attributes + synthesized attributes: + attributes : [(Identifier,Attributes,Attributes)] + collectChildrenInhs : Map Identifier Attributes + collectChildrenSyns : Map Identifier Attributes + errors : Seq Error + field : (Identifier,Type,Maybe (Maybe Type)) + gathAltAttrs : [AltAttr] + gathRules : Seq CRule + inhs : Seq (Identifier,Attributes) + nts : Seq (Identifier,NontermIdent) + singlevisits : [CRule] + terminals : [Identifier] + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} + visit 0: + local maptolocal : _ + local gathRules : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _inh _syn _virtual ) = + (sem_Child_Child _name _tp _inh _syn _virtual ) +-- semantic domain +newtype T_Child = T_Child (([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Attributes -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Bool -> + Attributes -> + ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Map Identifier Attributes ),(Seq Error),((Identifier,Type,Maybe (Maybe Type))),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier]))) +data Inh_Child = Inh_Child {allfields_Inh_Child :: !(([(Identifier,Type,Maybe (Maybe Type))])),allnts_Inh_Child :: !(([Identifier])),attrs_Inh_Child :: !(([(Identifier,Identifier)])),con_Inh_Child :: !(Identifier),inh_Inh_Child :: !(Attributes),mergeMap_Inh_Child :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Child :: !(Identifier),o_unbox_Inh_Child :: !(Bool),syn_Inh_Child :: !(Attributes)} +data Syn_Child = Syn_Child {attributes_Syn_Child :: !(([(Identifier,Attributes,Attributes)])),collectChildrenInhs_Syn_Child :: !((Map Identifier Attributes )),collectChildrenSyns_Syn_Child :: !((Map Identifier Attributes )),errors_Syn_Child :: !((Seq Error)),field_Syn_Child :: !(((Identifier,Type,Maybe (Maybe Type)))),gathAltAttrs_Syn_Child :: !(([AltAttr])),gathRules_Syn_Child :: !((Seq CRule)),inhs_Syn_Child :: !((Seq (Identifier,Attributes))),nts_Syn_Child :: !((Seq (Identifier,NontermIdent))),singlevisits_Syn_Child :: !(([CRule])),terminals_Syn_Child :: !(([Identifier]))} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem ) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn ) = + (let ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn + in (Syn_Child _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals )) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + (Maybe (Maybe Type)) -> + T_Child +sem_Child_Child name_ tp_ inh_ syn_ virtual_ = + (T_Child (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_unbox + _lhsIsyn -> + (let _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOnts :: (Seq (Identifier,NontermIdent)) + _lhsOinhs :: (Seq (Identifier,Attributes)) + _lhsOcollectChildrenSyns :: (Map Identifier Attributes ) + _lhsOcollectChildrenInhs :: (Map Identifier Attributes ) + _lhsOsinglevisits :: ([CRule]) + _lhsOterminals :: ([Identifier]) + _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOfield :: ((Identifier,Type,Maybe (Maybe Type))) + _lhsOerrors :: (Seq Error) + _lhsOgathRules :: (Seq CRule) + -- "Order.ag"(line 177, column 13) + _maptolocal = + ({-# LINE 177 "Order.ag" #-} + case tp_ of + NT nt _ -> Map.null syn_ + _ -> True + {-# LINE 320 "Order.hs" #-} + ) + -- "Order.ag"(line 180, column 13) + _lhsOgathAltAttrs = + ({-# LINE 180 "Order.ag" #-} + if _maptolocal + then [ AltAttr _LOC name_ True ] + else [ AltAttr name_ syn True | syn <- Map.keys syn_ ] + {-# LINE 328 "Order.hs" #-} + ) + -- "Order.ag"(line 195, column 13) + _lhsOnts = + ({-# LINE 195 "Order.ag" #-} + Seq.singleton (name_,getNtName tp_) + {-# LINE 334 "Order.hs" #-} + ) + -- "Order.ag"(line 196, column 13) + _lhsOinhs = + ({-# LINE 196 "Order.ag" #-} + Seq.singleton (name_,inh_) + {-# LINE 340 "Order.hs" #-} + ) + -- "Order.ag"(line 212, column 13) + _gathRules = + ({-# LINE 212 "Order.ag" #-} + if _maptolocal + then Seq.singleton (cRuleTerminal name_ _lhsInt _lhsIcon tp_) + else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs syn_] + {-# LINE 348 "Order.hs" #-} + ) + -- "Order.ag"(line 346, column 12) + _lhsOcollectChildrenSyns = + ({-# LINE 346 "Order.ag" #-} + Map.singleton name_ syn_ + {-# LINE 354 "Order.hs" #-} + ) + -- "Order.ag"(line 347, column 12) + _lhsOcollectChildrenInhs = + ({-# LINE 347 "Order.ag" #-} + Map.singleton name_ inh_ + {-# LINE 360 "Order.hs" #-} + ) + -- "Order.ag"(line 613, column 11) + _lhsOsinglevisits = + ({-# LINE 613 "Order.ag" #-} + if _maptolocal + then [] + else [CChildVisit name_ (getNtName tp_) 0 inh_ syn_ True] + {-# LINE 368 "Order.hs" #-} + ) + -- "Order.ag"(line 638, column 11) + _lhsOterminals = + ({-# LINE 638 "Order.ag" #-} + if _maptolocal + then [name_] + else [] + {-# LINE 376 "Order.hs" #-} + ) + -- "Order.ag"(line 667, column 11) + _lhsOattributes = + ({-# LINE 667 "Order.ag" #-} + [(name_, inh_, syn_)] + {-# LINE 382 "Order.hs" #-} + ) + -- "Order.ag"(line 671, column 11) + _lhsOfield = + ({-# LINE 671 "Order.ag" #-} + (name_, tp_, virtual_) + {-# LINE 388 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + Seq.empty + {-# LINE 394 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 206, column 23) + _lhsOgathRules = + ({-# LINE 206 "Order.ag" #-} + _gathRules + {-# LINE 400 "Order.hs" #-} + ) + in ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))) ) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,Maybe (Maybe Type))] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + inh : Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + o_unbox : Bool + syn : Attributes + synthesized attributes: + attributes : [(Identifier,Attributes,Attributes)] + collectChildrenInhs : Map Identifier Attributes + collectChildrenSyns : Map Identifier Attributes + errors : Seq Error + fields : [(Identifier,Type,Maybe (Maybe Type))] + gathAltAttrs : [AltAttr] + gathRules : Seq CRule + inhs : Seq (Identifier,Attributes) + nts : Seq (Identifier,NontermIdent) + singlevisits : [CRule] + terminals : [Identifier] + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) +-- semantic domain +newtype T_Children = T_Children (([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Attributes -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Bool -> + Attributes -> + ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Map Identifier Attributes ),(Seq Error),([(Identifier,Type,Maybe (Maybe Type))]),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier]))) +data Inh_Children = Inh_Children {allfields_Inh_Children :: !(([(Identifier,Type,Maybe (Maybe Type))])),allnts_Inh_Children :: !(([Identifier])),attrs_Inh_Children :: !(([(Identifier,Identifier)])),con_Inh_Children :: !(Identifier),inh_Inh_Children :: !(Attributes),mergeMap_Inh_Children :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Children :: !(Identifier),o_unbox_Inh_Children :: !(Bool),syn_Inh_Children :: !(Attributes)} +data Syn_Children = Syn_Children {attributes_Syn_Children :: !(([(Identifier,Attributes,Attributes)])),collectChildrenInhs_Syn_Children :: !((Map Identifier Attributes )),collectChildrenSyns_Syn_Children :: !((Map Identifier Attributes )),errors_Syn_Children :: !((Seq Error)),fields_Syn_Children :: !(([(Identifier,Type,Maybe (Maybe Type))])),gathAltAttrs_Syn_Children :: !(([AltAttr])),gathRules_Syn_Children :: !((Seq CRule)),inhs_Syn_Children :: !((Seq (Identifier,Attributes))),nts_Syn_Children :: !((Seq (Identifier,NontermIdent))),singlevisits_Syn_Children :: !(([CRule])),terminals_Syn_Children :: !(([Identifier]))} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem ) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn ) = + (let ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn + in (Syn_Children _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals )) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = + (T_Children (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_unbox + _lhsIsyn -> + (let _lhsOfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOcollectChildrenInhs :: (Map Identifier Attributes ) + _lhsOcollectChildrenSyns :: (Map Identifier Attributes ) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinhs :: (Seq (Identifier,Attributes)) + _lhsOnts :: (Seq (Identifier,NontermIdent)) + _lhsOsinglevisits :: ([CRule]) + _lhsOterminals :: ([Identifier]) + _hdOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _hdOallnts :: ([Identifier]) + _hdOattrs :: ([(Identifier,Identifier)]) + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _hdOnt :: Identifier + _hdOo_unbox :: Bool + _hdOsyn :: Attributes + _tlOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _tlOallnts :: ([Identifier]) + _tlOattrs :: ([(Identifier,Identifier)]) + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _tlOnt :: Identifier + _tlOo_unbox :: Bool + _tlOsyn :: Attributes + _hdIattributes :: ([(Identifier,Attributes,Attributes)]) + _hdIcollectChildrenInhs :: (Map Identifier Attributes ) + _hdIcollectChildrenSyns :: (Map Identifier Attributes ) + _hdIerrors :: (Seq Error) + _hdIfield :: ((Identifier,Type,Maybe (Maybe Type))) + _hdIgathAltAttrs :: ([AltAttr]) + _hdIgathRules :: (Seq CRule) + _hdIinhs :: (Seq (Identifier,Attributes)) + _hdInts :: (Seq (Identifier,NontermIdent)) + _hdIsinglevisits :: ([CRule]) + _hdIterminals :: ([Identifier]) + _tlIattributes :: ([(Identifier,Attributes,Attributes)]) + _tlIcollectChildrenInhs :: (Map Identifier Attributes ) + _tlIcollectChildrenSyns :: (Map Identifier Attributes ) + _tlIerrors :: (Seq Error) + _tlIfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _tlIgathAltAttrs :: ([AltAttr]) + _tlIgathRules :: (Seq CRule) + _tlIinhs :: (Seq (Identifier,Attributes)) + _tlInts :: (Seq (Identifier,NontermIdent)) + _tlIsinglevisits :: ([CRule]) + _tlIterminals :: ([Identifier]) + -- "Order.ag"(line 674, column 11) + _lhsOfields = + ({-# LINE 674 "Order.ag" #-} + _hdIfield : _tlIfields + {-# LINE 526 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 665, column 32) + _lhsOattributes = + ({-# LINE 665 "Order.ag" #-} + _hdIattributes ++ _tlIattributes + {-# LINE 532 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 344, column 68) + _lhsOcollectChildrenInhs = + ({-# LINE 344 "Order.ag" #-} + _hdIcollectChildrenInhs `Map.union` _tlIcollectChildrenInhs + {-# LINE 538 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 344, column 68) + _lhsOcollectChildrenSyns = + ({-# LINE 344 "Order.ag" #-} + _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns + {-# LINE 544 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 550 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + _hdIgathAltAttrs ++ _tlIgathAltAttrs + {-# LINE 556 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 206, column 23) + _lhsOgathRules = + ({-# LINE 206 "Order.ag" #-} + _hdIgathRules Seq.>< _tlIgathRules + {-# LINE 562 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 193, column 20) + _lhsOinhs = + ({-# LINE 193 "Order.ag" #-} + _hdIinhs Seq.>< _tlIinhs + {-# LINE 568 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 192, column 19) + _lhsOnts = + ({-# LINE 192 "Order.ag" #-} + _hdInts Seq.>< _tlInts + {-# LINE 574 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 611, column 40) + _lhsOsinglevisits = + ({-# LINE 611 "Order.ag" #-} + _hdIsinglevisits ++ _tlIsinglevisits + {-# LINE 580 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 636, column 38) + _lhsOterminals = + ({-# LINE 636 "Order.ag" #-} + _hdIterminals ++ _tlIterminals + {-# LINE 586 "Order.hs" #-} + ) + -- copy rule (down) + _hdOallfields = + ({-# LINE 654 "Order.ag" #-} + _lhsIallfields + {-# LINE 592 "Order.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 598 "Order.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 654 "Order.ag" #-} + _lhsIattrs + {-# LINE 604 "Order.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 610 "Order.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 616 "Order.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 362 "Order.ag" #-} + _lhsImergeMap + {-# LINE 622 "Order.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 628 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 119 "Order.ag" #-} + _lhsIo_unbox + {-# LINE 634 "Order.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 640 "Order.hs" #-} + ) + -- copy rule (down) + _tlOallfields = + ({-# LINE 654 "Order.ag" #-} + _lhsIallfields + {-# LINE 646 "Order.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 652 "Order.hs" #-} + ) + -- copy rule (down) + _tlOattrs = + ({-# LINE 654 "Order.ag" #-} + _lhsIattrs + {-# LINE 658 "Order.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 664 "Order.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 670 "Order.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 362 "Order.ag" #-} + _lhsImergeMap + {-# LINE 676 "Order.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 682 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 119 "Order.ag" #-} + _lhsIo_unbox + {-# LINE 688 "Order.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 694 "Order.hs" #-} + ) + ( _hdIattributes,_hdIcollectChildrenInhs,_hdIcollectChildrenSyns,_hdIerrors,_hdIfield,_hdIgathAltAttrs,_hdIgathRules,_hdIinhs,_hdInts,_hdIsinglevisits,_hdIterminals) = + hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOmergeMap _hdOnt _hdOo_unbox _hdOsyn + ( _tlIattributes,_tlIcollectChildrenInhs,_tlIcollectChildrenSyns,_tlIerrors,_tlIfields,_tlIgathAltAttrs,_tlIgathRules,_tlIinhs,_tlInts,_tlIsinglevisits,_tlIterminals) = + tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOmergeMap _tlOnt _tlOo_unbox _tlOsyn + in ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))) ) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_unbox + _lhsIsyn -> + (let _lhsOfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOcollectChildrenInhs :: (Map Identifier Attributes ) + _lhsOcollectChildrenSyns :: (Map Identifier Attributes ) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinhs :: (Seq (Identifier,Attributes)) + _lhsOnts :: (Seq (Identifier,NontermIdent)) + _lhsOsinglevisits :: ([CRule]) + _lhsOterminals :: ([Identifier]) + -- "Order.ag"(line 675, column 11) + _lhsOfields = + ({-# LINE 675 "Order.ag" #-} + [] + {-# LINE 727 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 665, column 32) + _lhsOattributes = + ({-# LINE 665 "Order.ag" #-} + [] + {-# LINE 733 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 344, column 68) + _lhsOcollectChildrenInhs = + ({-# LINE 344 "Order.ag" #-} + Map.empty + {-# LINE 739 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 344, column 68) + _lhsOcollectChildrenSyns = + ({-# LINE 344 "Order.ag" #-} + Map.empty + {-# LINE 745 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + Seq.empty + {-# LINE 751 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + [] + {-# LINE 757 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 206, column 23) + _lhsOgathRules = + ({-# LINE 206 "Order.ag" #-} + Seq.empty + {-# LINE 763 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 193, column 20) + _lhsOinhs = + ({-# LINE 193 "Order.ag" #-} + Seq.empty + {-# LINE 769 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 192, column 19) + _lhsOnts = + ({-# LINE 192 "Order.ag" #-} + Seq.empty + {-# LINE 775 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 611, column 40) + _lhsOsinglevisits = + ({-# LINE 611 "Order.ag" #-} + [] + {-# LINE 781 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 636, column 38) + _lhsOterminals = + ({-# LINE 636 "Order.ag" #-} + [] + {-# LINE 787 "Order.hs" #-} + ) + in ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))) ) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,Maybe (Maybe Type))] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + synthesized attributes: + allRhsVars : Set (Identifier,Identifier) + copy : SELF + errors : Seq Error + textLines : [String] + usedAttrs : [(Identifier,Identifier)] + usedFields : [Identifier] + usedLocals : [Identifier] + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local _tup1 : _ + local errors : _ + local textLines : _ + local usedAttrs : _ + local usedLocals : _ + local usedFields : _ + local copy : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = T_Expression (([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + ( (Set (Identifier,Identifier)),Expression ,(Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier]))) +data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: !(([(Identifier,Type,Maybe (Maybe Type))])),allnts_Inh_Expression :: !(([Identifier])),attrs_Inh_Expression :: !(([(Identifier,Identifier)])),con_Inh_Expression :: !(Identifier),mergeMap_Inh_Expression :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Expression :: !(Identifier)} +data Syn_Expression = Syn_Expression {allRhsVars_Syn_Expression :: !((Set (Identifier,Identifier))),copy_Syn_Expression :: !(Expression ),errors_Syn_Expression :: !((Seq Error)),textLines_Syn_Expression :: !(([String])),usedAttrs_Syn_Expression :: !(([(Identifier,Identifier)])),usedFields_Syn_Expression :: !(([Identifier])),usedLocals_Syn_Expression :: !(([Identifier]))} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt ) = + (let ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt + in (Syn_Expression _lhsOallRhsVars _lhsOcopy _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsImergeMap + _lhsInt -> + (let _lhsOallRhsVars :: (Set (Identifier,Identifier)) + _lhsOcopy :: Expression + _lhsOerrors :: (Seq Error) + _lhsOtextLines :: ([String]) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: ([Identifier]) + _lhsOusedLocals :: ([Identifier]) + -- "Order.ag"(line 464, column 21) + __tup1 = + ({-# LINE 464 "Order.ag" #-} + let mergedChildren = [ x | (_,xs) <- Map.elems _lhsImergeMap, x <- xs ] + attrsIn = filter (\(fld,_) -> not (fld `elem` mergedChildren)) _lhsIattrs + inherited = Inh_HsTokensRoot + { attrs_Inh_HsTokensRoot = attrsIn + , con_Inh_HsTokensRoot = _lhsIcon + , allfields_Inh_HsTokensRoot = _lhsIallfields + , allnts_Inh_HsTokensRoot = _lhsIallnts + , nt_Inh_HsTokensRoot = _lhsInt + } + synthesized = wrap_HsTokensRoot (sem_HsTokensRoot (HsTokensRoot tks_)) inherited + in case synthesized of + Syn_HsTokensRoot + { errors_Syn_HsTokensRoot = errors + , textLines_Syn_HsTokensRoot = textLines + , usedAttrs_Syn_HsTokensRoot = usedAttrs + , usedLocals_Syn_HsTokensRoot = usedLocals + , usedFields_Syn_HsTokensRoot = usedFields + } -> let extraAttrs = [ (src,attr) + | (fld,attr) <- usedAttrs, let mbMerged = Map.lookup fld _lhsImergeMap, isJust mbMerged + , let (Just (_, srcs)) = mbMerged, src <- srcs ] + usedAttrs' = usedAttrs ++ extraAttrs + in (errors,textLines,usedAttrs',usedLocals,usedFields) + {-# LINE 884 "Order.hs" #-} + ) + -- "Order.ag"(line 464, column 21) + (_errors,_,_,_,_) = + ({-# LINE 464 "Order.ag" #-} + __tup1 + {-# LINE 890 "Order.hs" #-} + ) + -- "Order.ag"(line 464, column 21) + (_,_textLines,_,_,_) = + ({-# LINE 464 "Order.ag" #-} + __tup1 + {-# LINE 896 "Order.hs" #-} + ) + -- "Order.ag"(line 464, column 21) + (_,_,_usedAttrs,_,_) = + ({-# LINE 464 "Order.ag" #-} + __tup1 + {-# LINE 902 "Order.hs" #-} + ) + -- "Order.ag"(line 464, column 21) + (_,_,_,_usedLocals,_) = + ({-# LINE 464 "Order.ag" #-} + __tup1 + {-# LINE 908 "Order.hs" #-} + ) + -- "Order.ag"(line 464, column 21) + (_,_,_,_,_usedFields) = + ({-# LINE 464 "Order.ag" #-} + __tup1 + {-# LINE 914 "Order.hs" #-} + ) + -- "Order.ag"(line 488, column 17) + _lhsOallRhsVars = + ({-# LINE 488 "Order.ag" #-} + Set.fromList _usedAttrs + `Set.union` + Set.fromList [ (_LOC, l) | l <- _usedLocals ] + `Set.union` + Set.fromList [ (_FIELD, fld) | fld <- _usedFields ] + {-# LINE 924 "Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 457 "Order.ag" #-} + Expression pos_ tks_ + {-# LINE 930 "Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 457 "Order.ag" #-} + _copy + {-# LINE 936 "Order.hs" #-} + ) + -- copy rule (from local) + _lhsOerrors = + ({-# LINE 452 "Order.ag" #-} + _errors + {-# LINE 942 "Order.hs" #-} + ) + -- copy rule (from local) + _lhsOtextLines = + ({-# LINE 456 "Order.ag" #-} + _textLines + {-# LINE 948 "Order.hs" #-} + ) + -- copy rule (from local) + _lhsOusedAttrs = + ({-# LINE 454 "Order.ag" #-} + _usedAttrs + {-# LINE 954 "Order.hs" #-} + ) + -- copy rule (from local) + _lhsOusedFields = + ({-# LINE 455 "Order.ag" #-} + _usedFields + {-# LINE 960 "Order.hs" #-} + ) + -- copy rule (from local) + _lhsOusedLocals = + ({-# LINE 453 "Order.ag" #-} + _usedLocals + {-# LINE 966 "Order.hs" #-} + ) + in ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + errors : Seq Error + nAutoRules : Int + nExplicitRules : Int + output : CGrammar + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + visit 0: + local o_dovisit : _ + local ruleTable : _ + local attrTable : _ + local attrVertex : _ + local tdpToTds : _ + local tdsToTdp : _ + local directDep : _ + local instDep : _ + local aroundDep : _ + local mergeDep : _ + local info : _ + local _tup2 : _ + local cInterfaceMap : _ + local cVisitsMap : _ + local cyclesErrors : _ + local aroundMap : _ + local mergeMap : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( (Seq Error),Int,Int,CGrammar)) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: !(Options)} +data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: !((Seq Error)),nAutoRules_Syn_Grammar :: !(Int),nExplicitRules_Syn_Grammar :: !(Int),output_Syn_Grammar :: !(CGrammar)} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) = + (let ( _lhsOerrors,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOoutput) = sem _lhsIoptions + in (Syn_Grammar _lhsOerrors _lhsOnAutoRules _lhsOnExplicitRules _lhsOoutput )) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (\ _lhsIoptions -> + (let _nontsOo_cata :: Bool + _nontsOo_data :: Bool + _nontsOo_sig :: Bool + _nontsOo_sem :: Bool + _nontsOo_rename :: Bool + _nontsOo_newtypes :: Bool + _nontsOo_wantvisit :: Bool + _nontsOo_unbox :: Bool + _nontsOo_case :: Bool + _nontsOprefix :: String + _nontsOvcount :: Int + _nontsOmanualAttrDepMap :: AttrOrderMap + _nontsOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _nontsOacount :: Int + _lhsOerrors :: (Seq Error) + _lhsOoutput :: CGrammar + _nontsOallnts :: ([Identifier]) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _nontsOcInterfaceMap :: CInterfaceMap + _nontsOcVisitsMap :: CVisitsMap + _nontsOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _nontsOo_dovisit :: Bool + _nontsIacount :: Int + _nontsIadditionalDep :: (Seq Edge) + _nontsIaranges :: (Seq (Int,Int,Int)) + _nontsIaroundDep :: (Seq Edge) + _nontsIcNonterminals :: CNonterminals + _nontsIdirectDep :: (Seq Edge) + _nontsIerrors :: (Seq Error) + _nontsIinstDep :: (Seq Edge) + _nontsImergeDep :: (Seq Edge) + _nontsInAutoRules :: Int + _nontsInExplicitRules :: Int + _nontsInonts :: ([(NontermIdent,[ConstructorIdent])]) + _nontsIntattrs :: (Seq (Vertex,NTAttr)) + _nontsIrules :: (Seq (Vertex,CRule)) + _nontsIvcount :: Int + -- "Order.ag"(line 123, column 17) + _o_dovisit = + ({-# LINE 123 "Order.ag" #-} + visit _lhsIoptions && null _cyclesErrors + {-# LINE 1089 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_cata = + ({-# LINE 124 "Order.ag" #-} + folds _lhsIoptions + {-# LINE 1095 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_data = + ({-# LINE 125 "Order.ag" #-} + dataTypes _lhsIoptions + {-# LINE 1101 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_sig = + ({-# LINE 126 "Order.ag" #-} + typeSigs _lhsIoptions + {-# LINE 1107 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_sem = + ({-# LINE 127 "Order.ag" #-} + semfuns _lhsIoptions + {-# LINE 1113 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_rename = + ({-# LINE 128 "Order.ag" #-} + rename _lhsIoptions + {-# LINE 1119 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_newtypes = + ({-# LINE 129 "Order.ag" #-} + newtypes _lhsIoptions + {-# LINE 1125 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_wantvisit = + ({-# LINE 130 "Order.ag" #-} + visit _lhsIoptions + {-# LINE 1131 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_unbox = + ({-# LINE 131 "Order.ag" #-} + unbox _lhsIoptions + {-# LINE 1137 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOo_case = + ({-# LINE 132 "Order.ag" #-} + cases _lhsIoptions + {-# LINE 1143 "Order.hs" #-} + ) + -- "Order.ag"(line 124, column 17) + _nontsOprefix = + ({-# LINE 133 "Order.ag" #-} + prefix _lhsIoptions + {-# LINE 1149 "Order.hs" #-} + ) + -- "Order.ag"(line 261, column 15) + _nontsOvcount = + ({-# LINE 261 "Order.ag" #-} + 0 + {-# LINE 1155 "Order.hs" #-} + ) + -- "Order.ag"(line 287, column 7) + _nontsOmanualAttrDepMap = + ({-# LINE 287 "Order.ag" #-} + manualAttrOrderMap_ + {-# LINE 1161 "Order.hs" #-} + ) + -- "Order.ag"(line 416, column 14) + _nontsOaroundMap = + ({-# LINE 416 "Order.ag" #-} + aroundsMap_ + {-# LINE 1167 "Order.hs" #-} + ) + -- "Order.ag"(line 503, column 13) + _nontsOacount = + ({-# LINE 503 "Order.ag" #-} + 0 + {-# LINE 1173 "Order.hs" #-} + ) + -- "Order.ag"(line 541, column 13) + _ruleTable = + ({-# LINE 541 "Order.ag" #-} + Array.array (0,_nontsIvcount-1) (toList _nontsIrules) + {-# LINE 1179 "Order.hs" #-} + ) + -- "Order.ag"(line 542, column 13) + _attrTable = + ({-# LINE 542 "Order.ag" #-} + Array.array (0,_nontsIacount-1) (toList _nontsIntattrs) + {-# LINE 1185 "Order.hs" #-} + ) + -- "Order.ag"(line 543, column 13) + _attrVertex = + ({-# LINE 543 "Order.ag" #-} + Map.fromList (map swap (toList _nontsIntattrs)) + {-# LINE 1191 "Order.hs" #-} + ) + -- "Order.ag"(line 544, column 13) + _tdpToTds = + ({-# LINE 544 "Order.ag" #-} + [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr)) + | (s,cr) <- toList _nontsIrules] + {-# LINE 1198 "Order.hs" #-} + ) + -- "Order.ag"(line 546, column 13) + _tdsToTdp = + ({-# LINE 546 "Order.ag" #-} + let eq (_,v) (_,v') = v == v' + conv ((s,v):svs) | v == -1 = Nothing + | otherwise = Just (v,s:map fst svs) + in mapMaybe conv (eqClasses eq _tdpToTds) + {-# LINE 1207 "Order.hs" #-} + ) + -- "Order.ag"(line 550, column 13) + _directDep = + ({-# LINE 550 "Order.ag" #-} + toList (_nontsIdirectDep Seq.>< _nontsIadditionalDep) + {-# LINE 1213 "Order.hs" #-} + ) + -- "Order.ag"(line 551, column 13) + _instDep = + ({-# LINE 551 "Order.ag" #-} + toList _nontsIinstDep + {-# LINE 1219 "Order.hs" #-} + ) + -- "Order.ag"(line 552, column 13) + _aroundDep = + ({-# LINE 552 "Order.ag" #-} + toList _nontsIaroundDep + {-# LINE 1225 "Order.hs" #-} + ) + -- "Order.ag"(line 553, column 13) + _mergeDep = + ({-# LINE 553 "Order.ag" #-} + toList _nontsImergeDep + {-# LINE 1231 "Order.hs" #-} + ) + -- "Order.ag"(line 554, column 13) + _info = + ({-# LINE 554 "Order.ag" #-} + let def [] = -1 + def (v:vs) = v + in Info { tdsToTdp = Array.array (0,_nontsIacount-1) _tdsToTdp + , tdpToTds = Array.array (0,_nontsIvcount-1) _tdpToTds + , attrTable = _attrTable + , ruleTable = _ruleTable + , lmh = toList _nontsIaranges + , nonts = _nontsInonts + , wraps = wrappers_ + } + {-# LINE 1246 "Order.hs" #-} + ) + -- "Order.ag"(line 565, column 17) + __tup2 = + ({-# LINE 565 "Order.ag" #-} + case computeSequential _info _directDep (_instDep ++ _aroundDep ++ _mergeDep ) of + CycleFree cim cvm -> ( cim + , cvm + , [] + ) + LocalCycle errs -> ( error "No interfaces for AG with local cycles" + , error "No visit sub-sequences for AG with local cycles" + , map (localCycleErr _ruleTable (visit _lhsIoptions)) errs + ) + InstCycle errs -> ( error "No interfaces for AG with cycles through insts" + , error "No visit sub-sequences for AG with cycles through insts" + , map (instCycleErr _ruleTable (visit _lhsIoptions)) errs + ) + DirectCycle errs -> ( error "No interfaces for AG with direct cycles" + , error "No visit sub-sequences for AG with direct cycles" + , directCycleErrs _attrTable _ruleTable (visit _lhsIoptions) errs + ) + InducedCycle cim errs -> ( cim + , error "No visit sub-sequences for AG with induced cycles" + , inducedCycleErrs _attrTable _ruleTable cim errs + ) + {-# LINE 1272 "Order.hs" #-} + ) + -- "Order.ag"(line 565, column 17) + (_cInterfaceMap,_,_) = + ({-# LINE 565 "Order.ag" #-} + __tup2 + {-# LINE 1278 "Order.hs" #-} + ) + -- "Order.ag"(line 565, column 17) + (_,_cVisitsMap,_) = + ({-# LINE 565 "Order.ag" #-} + __tup2 + {-# LINE 1284 "Order.hs" #-} + ) + -- "Order.ag"(line 565, column 17) + (_,_,_cyclesErrors) = + ({-# LINE 565 "Order.ag" #-} + __tup2 + {-# LINE 1290 "Order.hs" #-} + ) + -- "Order.ag"(line 587, column 13) + _lhsOerrors = + ({-# LINE 587 "Order.ag" #-} + (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty) + Seq.>< _nontsIerrors + {-# LINE 1297 "Order.hs" #-} + ) + -- "Order.ag"(line 619, column 15) + _lhsOoutput = + ({-# LINE 619 "Order.ag" #-} + CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_ quantMap_ _aroundMap _mergeMap _o_dovisit + {-# LINE 1303 "Order.hs" #-} + ) + -- "Order.ag"(line 632, column 14) + _aroundMap = + ({-# LINE 632 "Order.ag" #-} + Map.map (Map.map Map.keysSet) aroundsMap_ + {-# LINE 1309 "Order.hs" #-} + ) + -- "Order.ag"(line 633, column 14) + _mergeMap = + ({-# LINE 633 "Order.ag" #-} + Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ + {-# LINE 1315 "Order.hs" #-} + ) + -- "Order.ag"(line 650, column 13) + _nontsOallnts = + ({-# LINE 650 "Order.ag" #-} + map fst (_nontsInonts) + {-# LINE 1321 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + _nontsInAutoRules + {-# LINE 1327 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + _nontsInExplicitRules + {-# LINE 1333 "Order.hs" #-} + ) + -- copy rule (from local) + _nontsOcInterfaceMap = + ({-# LINE 594 "Order.ag" #-} + _cInterfaceMap + {-# LINE 1339 "Order.hs" #-} + ) + -- copy rule (from local) + _nontsOcVisitsMap = + ({-# LINE 601 "Order.ag" #-} + _cVisitsMap + {-# LINE 1345 "Order.hs" #-} + ) + -- copy rule (from local) + _nontsOmergeMap = + ({-# LINE 354 "Order.ag" #-} + _mergeMap + {-# LINE 1351 "Order.hs" #-} + ) + -- copy rule (from local) + _nontsOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _o_dovisit + {-# LINE 1357 "Order.hs" #-} + ) + ( _nontsIacount,_nontsIadditionalDep,_nontsIaranges,_nontsIaroundDep,_nontsIcNonterminals,_nontsIdirectDep,_nontsIerrors,_nontsIinstDep,_nontsImergeDep,_nontsInAutoRules,_nontsInExplicitRules,_nontsInonts,_nontsIntattrs,_nontsIrules,_nontsIvcount) = + nonts_ _nontsOacount _nontsOallnts _nontsOaroundMap _nontsOcInterfaceMap _nontsOcVisitsMap _nontsOmanualAttrDepMap _nontsOmergeMap _nontsOo_case _nontsOo_cata _nontsOo_data _nontsOo_dovisit _nontsOo_newtypes _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_unbox _nontsOo_wantvisit _nontsOprefix _nontsOvcount + in ( _lhsOerrors,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOoutput))) ) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + aroundMap : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cInterfaceMap : CInterfaceMap + cVisitsMap : CVisitsMap + manualAttrDepMap : AttrOrderMap + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + o_case : Bool + o_cata : Bool + o_data : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_unbox : Bool + o_wantvisit : Bool + prefix : String + chained attributes: + acount : Int + vcount : Int + synthesized attributes: + additionalDep : Seq Edge + aranges : Seq (Int,Int,Int) + aroundDep : Seq Edge + cNonterminal : CNonterminal + directDep : Seq Edge + errors : Seq Error + instDep : Seq Edge + mergeDep : Seq Edge + nAutoRules : Int + nExplicitRules : Int + nonts : [(NontermIdent,[ConstructorIdent])] + ntattrs : Seq (Vertex,NTAttr) + rules : Seq (Vertex,CRule) + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 0: + local mergeMap : _ + local aroundMap : _ + local ntattrs : _ + local cInter : _ +-} +-- cata +sem_Nonterminal :: Nonterminal -> + T_Nonterminal +sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods ) = + (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) +-- semantic domain +newtype T_Nonterminal = T_Nonterminal (Int -> + ([Identifier]) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + CInterfaceMap -> + CVisitsMap -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Int -> + ( Int,(Seq Edge),(Seq (Int,Int,Int)),(Seq Edge),CNonterminal,(Seq Edge),(Seq Error),(Seq Edge),(Seq Edge),Int,Int,([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),Int)) +data Inh_Nonterminal = Inh_Nonterminal {acount_Inh_Nonterminal :: !(Int),allnts_Inh_Nonterminal :: !(([Identifier])),aroundMap_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cInterfaceMap_Inh_Nonterminal :: !(CInterfaceMap),cVisitsMap_Inh_Nonterminal :: !(CVisitsMap),manualAttrDepMap_Inh_Nonterminal :: !(AttrOrderMap),mergeMap_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))),o_case_Inh_Nonterminal :: !(Bool),o_cata_Inh_Nonterminal :: !(Bool),o_data_Inh_Nonterminal :: !(Bool),o_dovisit_Inh_Nonterminal :: !(Bool),o_newtypes_Inh_Nonterminal :: !(Bool),o_rename_Inh_Nonterminal :: !(Bool),o_sem_Inh_Nonterminal :: !(Bool),o_sig_Inh_Nonterminal :: !(Bool),o_unbox_Inh_Nonterminal :: !(Bool),o_wantvisit_Inh_Nonterminal :: !(Bool),prefix_Inh_Nonterminal :: !(String),vcount_Inh_Nonterminal :: !(Int)} +data Syn_Nonterminal = Syn_Nonterminal {acount_Syn_Nonterminal :: !(Int),additionalDep_Syn_Nonterminal :: !((Seq Edge)),aranges_Syn_Nonterminal :: !((Seq (Int,Int,Int))),aroundDep_Syn_Nonterminal :: !((Seq Edge)),cNonterminal_Syn_Nonterminal :: !(CNonterminal),directDep_Syn_Nonterminal :: !((Seq Edge)),errors_Syn_Nonterminal :: !((Seq Error)),instDep_Syn_Nonterminal :: !((Seq Edge)),mergeDep_Syn_Nonterminal :: !((Seq Edge)),nAutoRules_Syn_Nonterminal :: !(Int),nExplicitRules_Syn_Nonterminal :: !(Int),nonts_Syn_Nonterminal :: !(([(NontermIdent,[ConstructorIdent])])),ntattrs_Syn_Nonterminal :: !((Seq (Vertex,NTAttr))),rules_Syn_Nonterminal :: !((Seq (Vertex,CRule))),vcount_Syn_Nonterminal :: !(Int)} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount ) = + (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) = sem _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount + in (Syn_Nonterminal _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminal _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOvcount )) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = + (T_Nonterminal (\ _lhsIacount + _lhsIallnts + _lhsIaroundMap + _lhsIcInterfaceMap + _lhsIcVisitsMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_data + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIvcount -> + (let _prodsOnt :: Identifier + _prodsOinh :: Attributes + _prodsOsyn :: Attributes + _lhsOntattrs :: (Seq (Vertex,NTAttr)) + _lhsOacount :: Int + _lhsOaranges :: (Seq (Int,Int,Int)) + _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _lhsOcNonterminal :: CNonterminal + _lhsOadditionalDep :: (Seq Edge) + _lhsOaroundDep :: (Seq Edge) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOvcount :: Int + _prodsOallnts :: ([Identifier]) + _prodsOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _prodsOcVisitsMap :: CVisitsMap + _prodsOmanualAttrDepMap :: AttrOrderMap + _prodsOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _prodsOo_case :: Bool + _prodsOo_cata :: Bool + _prodsOo_dovisit :: Bool + _prodsOo_newtypes :: Bool + _prodsOo_rename :: Bool + _prodsOo_sem :: Bool + _prodsOo_sig :: Bool + _prodsOo_unbox :: Bool + _prodsOo_wantvisit :: Bool + _prodsOprefix :: String + _prodsOvcount :: Int + _prodsIadditionalDep :: (Seq Edge) + _prodsIaroundDep :: (Seq Edge) + _prodsIcProductions :: CProductions + _prodsIcons :: ([ConstructorIdent]) + _prodsIdirectDep :: (Seq Edge) + _prodsIerrors :: (Seq Error) + _prodsIinstDep :: (Seq Edge) + _prodsImergeDep :: (Seq Edge) + _prodsInAutoRules :: Int + _prodsInExplicitRules :: Int + _prodsIrules :: (Seq (Vertex,CRule)) + _prodsIvcount :: Int + -- "Order.ag"(line 97, column 17) + _prodsOnt = + ({-# LINE 97 "Order.ag" #-} + nt_ + {-# LINE 1523 "Order.hs" #-} + ) + -- "Order.ag"(line 100, column 17) + _prodsOinh = + ({-# LINE 100 "Order.ag" #-} + inh_ + {-# LINE 1529 "Order.hs" #-} + ) + -- "Order.ag"(line 101, column 17) + _prodsOsyn = + ({-# LINE 101 "Order.ag" #-} + syn_ + {-# LINE 1535 "Order.hs" #-} + ) + -- "Order.ag"(line 359, column 32) + _mergeMap = + ({-# LINE 359 "Order.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergeMap + {-# LINE 1541 "Order.hs" #-} + ) + -- "Order.ag"(line 412, column 32) + _aroundMap = + ({-# LINE 412 "Order.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundMap + {-# LINE 1547 "Order.hs" #-} + ) + -- "Order.ag"(line 506, column 17) + _ntattrs = + ({-# LINE 506 "Order.ag" #-} + [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ] + ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ] + {-# LINE 1554 "Order.hs" #-} + ) + -- "Order.ag"(line 508, column 17) + _lhsOntattrs = + ({-# LINE 508 "Order.ag" #-} + Seq.fromList (zip [_lhsIacount ..] _ntattrs) + {-# LINE 1560 "Order.hs" #-} + ) + -- "Order.ag"(line 509, column 17) + _lhsOacount = + ({-# LINE 509 "Order.ag" #-} + _lhsIacount + Map.size inh_ + Map.size syn_ + {-# LINE 1566 "Order.hs" #-} + ) + -- "Order.ag"(line 510, column 17) + _lhsOaranges = + ({-# LINE 510 "Order.ag" #-} + Seq.singleton + (_lhsIacount + ,_lhsIacount + Map.size inh_ + ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1) + {-# LINE 1575 "Order.hs" #-} + ) + -- "Order.ag"(line 519, column 19) + _lhsOnonts = + ({-# LINE 519 "Order.ag" #-} + [(nt_,_prodsIcons)] + {-# LINE 1581 "Order.hs" #-} + ) + -- "Order.ag"(line 596, column 19) + _cInter = + ({-# LINE 596 "Order.ag" #-} + if _lhsIo_dovisit + then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap + else CInterface [CSegment inh_ syn_] + {-# LINE 1589 "Order.hs" #-} + ) + -- "Order.ag"(line 624, column 19) + _lhsOcNonterminal = + ({-# LINE 624 "Order.ag" #-} + CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter + {-# LINE 1595 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 283, column 60) + _lhsOadditionalDep = + ({-# LINE 283 "Order.ag" #-} + _prodsIadditionalDep + {-# LINE 1601 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 404, column 24) + _lhsOaroundDep = + ({-# LINE 404 "Order.ag" #-} + _prodsIaroundDep + {-# LINE 1607 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 269, column 33) + _lhsOdirectDep = + ({-# LINE 269 "Order.ag" #-} + _prodsIdirectDep + {-# LINE 1613 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _prodsIerrors + {-# LINE 1619 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 312, column 31) + _lhsOinstDep = + ({-# LINE 312 "Order.ag" #-} + _prodsIinstDep + {-# LINE 1625 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 367, column 18) + _lhsOmergeDep = + ({-# LINE 367 "Order.ag" #-} + _prodsImergeDep + {-# LINE 1631 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + _prodsInAutoRules + {-# LINE 1637 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + _prodsInExplicitRules + {-# LINE 1643 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 259, column 18) + _lhsOrules = + ({-# LINE 259 "Order.ag" #-} + _prodsIrules + {-# LINE 1649 "Order.hs" #-} + ) + -- copy rule (up) + _lhsOvcount = + ({-# LINE 258 "Order.ag" #-} + _prodsIvcount + {-# LINE 1655 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 1661 "Order.hs" #-} + ) + -- copy rule (from local) + _prodsOaroundMap = + ({-# LINE 410 "Order.ag" #-} + _aroundMap + {-# LINE 1667 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOcVisitsMap = + ({-# LINE 601 "Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 1673 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOmanualAttrDepMap = + ({-# LINE 283 "Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 1679 "Order.hs" #-} + ) + -- copy rule (from local) + _prodsOmergeMap = + ({-# LINE 357 "Order.ag" #-} + _mergeMap + {-# LINE 1685 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_case = + ({-# LINE 117 "Order.ag" #-} + _lhsIo_case + {-# LINE 1691 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_cata = + ({-# LINE 111 "Order.ag" #-} + _lhsIo_cata + {-# LINE 1697 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _lhsIo_dovisit + {-# LINE 1703 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_newtypes = + ({-# LINE 110 "Order.ag" #-} + _lhsIo_newtypes + {-# LINE 1709 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_rename = + ({-# LINE 114 "Order.ag" #-} + _lhsIo_rename + {-# LINE 1715 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_sem = + ({-# LINE 113 "Order.ag" #-} + _lhsIo_sem + {-# LINE 1721 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_sig = + ({-# LINE 112 "Order.ag" #-} + _lhsIo_sig + {-# LINE 1727 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_unbox = + ({-# LINE 119 "Order.ag" #-} + _lhsIo_unbox + {-# LINE 1733 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_wantvisit = + ({-# LINE 115 "Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 1739 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOprefix = + ({-# LINE 118 "Order.ag" #-} + _lhsIprefix + {-# LINE 1745 "Order.hs" #-} + ) + -- copy rule (down) + _prodsOvcount = + ({-# LINE 258 "Order.ag" #-} + _lhsIvcount + {-# LINE 1751 "Order.hs" #-} + ) + ( _prodsIadditionalDep,_prodsIaroundDep,_prodsIcProductions,_prodsIcons,_prodsIdirectDep,_prodsIerrors,_prodsIinstDep,_prodsImergeDep,_prodsInAutoRules,_prodsInExplicitRules,_prodsIrules,_prodsIvcount) = + prods_ _prodsOallnts _prodsOaroundMap _prodsOcVisitsMap _prodsOinh _prodsOmanualAttrDepMap _prodsOmergeMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_dovisit _prodsOo_newtypes _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_unbox _prodsOo_wantvisit _prodsOprefix _prodsOsyn _prodsOvcount + in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))) ) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + allnts : [Identifier] + aroundMap : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cInterfaceMap : CInterfaceMap + cVisitsMap : CVisitsMap + manualAttrDepMap : AttrOrderMap + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + o_case : Bool + o_cata : Bool + o_data : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_unbox : Bool + o_wantvisit : Bool + prefix : String + chained attributes: + acount : Int + vcount : Int + synthesized attributes: + additionalDep : Seq Edge + aranges : Seq (Int,Int,Int) + aroundDep : Seq Edge + cNonterminals : CNonterminals + directDep : Seq Edge + errors : Seq Error + instDep : Seq Edge + mergeDep : Seq Edge + nAutoRules : Int + nExplicitRules : Int + nonts : [(NontermIdent,[ConstructorIdent])] + ntattrs : Seq (Vertex,NTAttr) + rules : Seq (Vertex,CRule) + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals (Int -> + ([Identifier]) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + CInterfaceMap -> + CVisitsMap -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Int -> + ( Int,(Seq Edge),(Seq (Int,Int,Int)),(Seq Edge),CNonterminals,(Seq Edge),(Seq Error),(Seq Edge),(Seq Edge),Int,Int,([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),Int)) +data Inh_Nonterminals = Inh_Nonterminals {acount_Inh_Nonterminals :: !(Int),allnts_Inh_Nonterminals :: !(([Identifier])),aroundMap_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cInterfaceMap_Inh_Nonterminals :: !(CInterfaceMap),cVisitsMap_Inh_Nonterminals :: !(CVisitsMap),manualAttrDepMap_Inh_Nonterminals :: !(AttrOrderMap),mergeMap_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))),o_case_Inh_Nonterminals :: !(Bool),o_cata_Inh_Nonterminals :: !(Bool),o_data_Inh_Nonterminals :: !(Bool),o_dovisit_Inh_Nonterminals :: !(Bool),o_newtypes_Inh_Nonterminals :: !(Bool),o_rename_Inh_Nonterminals :: !(Bool),o_sem_Inh_Nonterminals :: !(Bool),o_sig_Inh_Nonterminals :: !(Bool),o_unbox_Inh_Nonterminals :: !(Bool),o_wantvisit_Inh_Nonterminals :: !(Bool),prefix_Inh_Nonterminals :: !(String),vcount_Inh_Nonterminals :: !(Int)} +data Syn_Nonterminals = Syn_Nonterminals {acount_Syn_Nonterminals :: !(Int),additionalDep_Syn_Nonterminals :: !((Seq Edge)),aranges_Syn_Nonterminals :: !((Seq (Int,Int,Int))),aroundDep_Syn_Nonterminals :: !((Seq Edge)),cNonterminals_Syn_Nonterminals :: !(CNonterminals),directDep_Syn_Nonterminals :: !((Seq Edge)),errors_Syn_Nonterminals :: !((Seq Error)),instDep_Syn_Nonterminals :: !((Seq Edge)),mergeDep_Syn_Nonterminals :: !((Seq Edge)),nAutoRules_Syn_Nonterminals :: !(Int),nExplicitRules_Syn_Nonterminals :: !(Int),nonts_Syn_Nonterminals :: !(([(NontermIdent,[ConstructorIdent])])),ntattrs_Syn_Nonterminals :: !((Seq (Vertex,NTAttr))),rules_Syn_Nonterminals :: !((Seq (Vertex,CRule))),vcount_Syn_Nonterminals :: !(Int)} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount ) = + (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) = sem _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount + in (Syn_Nonterminals _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOvcount )) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = + (T_Nonterminals (\ _lhsIacount + _lhsIallnts + _lhsIaroundMap + _lhsIcInterfaceMap + _lhsIcVisitsMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_data + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIvcount -> + (let _lhsOcNonterminals :: CNonterminals + _lhsOadditionalDep :: (Seq Edge) + _lhsOaranges :: (Seq (Int,Int,Int)) + _lhsOaroundDep :: (Seq Edge) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _lhsOntattrs :: (Seq (Vertex,NTAttr)) + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOacount :: Int + _lhsOvcount :: Int + _hdOacount :: Int + _hdOallnts :: ([Identifier]) + _hdOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _hdOcInterfaceMap :: CInterfaceMap + _hdOcVisitsMap :: CVisitsMap + _hdOmanualAttrDepMap :: AttrOrderMap + _hdOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_data :: Bool + _hdOo_dovisit :: Bool + _hdOo_newtypes :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_unbox :: Bool + _hdOo_wantvisit :: Bool + _hdOprefix :: String + _hdOvcount :: Int + _tlOacount :: Int + _tlOallnts :: ([Identifier]) + _tlOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _tlOcInterfaceMap :: CInterfaceMap + _tlOcVisitsMap :: CVisitsMap + _tlOmanualAttrDepMap :: AttrOrderMap + _tlOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_data :: Bool + _tlOo_dovisit :: Bool + _tlOo_newtypes :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_unbox :: Bool + _tlOo_wantvisit :: Bool + _tlOprefix :: String + _tlOvcount :: Int + _hdIacount :: Int + _hdIadditionalDep :: (Seq Edge) + _hdIaranges :: (Seq (Int,Int,Int)) + _hdIaroundDep :: (Seq Edge) + _hdIcNonterminal :: CNonterminal + _hdIdirectDep :: (Seq Edge) + _hdIerrors :: (Seq Error) + _hdIinstDep :: (Seq Edge) + _hdImergeDep :: (Seq Edge) + _hdInAutoRules :: Int + _hdInExplicitRules :: Int + _hdInonts :: ([(NontermIdent,[ConstructorIdent])]) + _hdIntattrs :: (Seq (Vertex,NTAttr)) + _hdIrules :: (Seq (Vertex,CRule)) + _hdIvcount :: Int + _tlIacount :: Int + _tlIadditionalDep :: (Seq Edge) + _tlIaranges :: (Seq (Int,Int,Int)) + _tlIaroundDep :: (Seq Edge) + _tlIcNonterminals :: CNonterminals + _tlIdirectDep :: (Seq Edge) + _tlIerrors :: (Seq Error) + _tlIinstDep :: (Seq Edge) + _tlImergeDep :: (Seq Edge) + _tlInAutoRules :: Int + _tlInExplicitRules :: Int + _tlInonts :: ([(NontermIdent,[ConstructorIdent])]) + _tlIntattrs :: (Seq (Vertex,NTAttr)) + _tlIrules :: (Seq (Vertex,CRule)) + _tlIvcount :: Int + -- "Order.ag"(line 621, column 12) + _lhsOcNonterminals = + ({-# LINE 621 "Order.ag" #-} + _hdIcNonterminal : _tlIcNonterminals + {-# LINE 1944 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 283, column 60) + _lhsOadditionalDep = + ({-# LINE 283 "Order.ag" #-} + _hdIadditionalDep Seq.>< _tlIadditionalDep + {-# LINE 1950 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 500, column 36) + _lhsOaranges = + ({-# LINE 500 "Order.ag" #-} + _hdIaranges Seq.>< _tlIaranges + {-# LINE 1956 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 404, column 24) + _lhsOaroundDep = + ({-# LINE 404 "Order.ag" #-} + _hdIaroundDep Seq.>< _tlIaroundDep + {-# LINE 1962 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 269, column 33) + _lhsOdirectDep = + ({-# LINE 269 "Order.ag" #-} + _hdIdirectDep Seq.>< _tlIdirectDep + {-# LINE 1968 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1974 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 312, column 31) + _lhsOinstDep = + ({-# LINE 312 "Order.ag" #-} + _hdIinstDep Seq.>< _tlIinstDep + {-# LINE 1980 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 367, column 18) + _lhsOmergeDep = + ({-# LINE 367 "Order.ag" #-} + _hdImergeDep Seq.>< _tlImergeDep + {-# LINE 1986 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + _hdInAutoRules + _tlInAutoRules + {-# LINE 1992 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + _hdInExplicitRules + _tlInExplicitRules + {-# LINE 1998 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 517, column 43) + _lhsOnonts = + ({-# LINE 517 "Order.ag" #-} + _hdInonts ++ _tlInonts + {-# LINE 2004 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 499, column 35) + _lhsOntattrs = + ({-# LINE 499 "Order.ag" #-} + _hdIntattrs Seq.>< _tlIntattrs + {-# LINE 2010 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 259, column 18) + _lhsOrules = + ({-# LINE 259 "Order.ag" #-} + _hdIrules Seq.>< _tlIrules + {-# LINE 2016 "Order.hs" #-} + ) + -- copy rule (up) + _lhsOacount = + ({-# LINE 499 "Order.ag" #-} + _tlIacount + {-# LINE 2022 "Order.hs" #-} + ) + -- copy rule (up) + _lhsOvcount = + ({-# LINE 258 "Order.ag" #-} + _tlIvcount + {-# LINE 2028 "Order.hs" #-} + ) + -- copy rule (down) + _hdOacount = + ({-# LINE 499 "Order.ag" #-} + _lhsIacount + {-# LINE 2034 "Order.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 2040 "Order.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 407 "Order.ag" #-} + _lhsIaroundMap + {-# LINE 2046 "Order.hs" #-} + ) + -- copy rule (down) + _hdOcInterfaceMap = + ({-# LINE 594 "Order.ag" #-} + _lhsIcInterfaceMap + {-# LINE 2052 "Order.hs" #-} + ) + -- copy rule (down) + _hdOcVisitsMap = + ({-# LINE 601 "Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 2058 "Order.hs" #-} + ) + -- copy rule (down) + _hdOmanualAttrDepMap = + ({-# LINE 283 "Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 2064 "Order.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 354 "Order.ag" #-} + _lhsImergeMap + {-# LINE 2070 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 117 "Order.ag" #-} + _lhsIo_case + {-# LINE 2076 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 111 "Order.ag" #-} + _lhsIo_cata + {-# LINE 2082 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 120 "Order.ag" #-} + _lhsIo_data + {-# LINE 2088 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _lhsIo_dovisit + {-# LINE 2094 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 110 "Order.ag" #-} + _lhsIo_newtypes + {-# LINE 2100 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 114 "Order.ag" #-} + _lhsIo_rename + {-# LINE 2106 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 113 "Order.ag" #-} + _lhsIo_sem + {-# LINE 2112 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 112 "Order.ag" #-} + _lhsIo_sig + {-# LINE 2118 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 119 "Order.ag" #-} + _lhsIo_unbox + {-# LINE 2124 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_wantvisit = + ({-# LINE 115 "Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 2130 "Order.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 118 "Order.ag" #-} + _lhsIprefix + {-# LINE 2136 "Order.hs" #-} + ) + -- copy rule (down) + _hdOvcount = + ({-# LINE 258 "Order.ag" #-} + _lhsIvcount + {-# LINE 2142 "Order.hs" #-} + ) + -- copy rule (chain) + _tlOacount = + ({-# LINE 499 "Order.ag" #-} + _hdIacount + {-# LINE 2148 "Order.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 2154 "Order.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 407 "Order.ag" #-} + _lhsIaroundMap + {-# LINE 2160 "Order.hs" #-} + ) + -- copy rule (down) + _tlOcInterfaceMap = + ({-# LINE 594 "Order.ag" #-} + _lhsIcInterfaceMap + {-# LINE 2166 "Order.hs" #-} + ) + -- copy rule (down) + _tlOcVisitsMap = + ({-# LINE 601 "Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 2172 "Order.hs" #-} + ) + -- copy rule (down) + _tlOmanualAttrDepMap = + ({-# LINE 283 "Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 2178 "Order.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 354 "Order.ag" #-} + _lhsImergeMap + {-# LINE 2184 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 117 "Order.ag" #-} + _lhsIo_case + {-# LINE 2190 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 111 "Order.ag" #-} + _lhsIo_cata + {-# LINE 2196 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 120 "Order.ag" #-} + _lhsIo_data + {-# LINE 2202 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _lhsIo_dovisit + {-# LINE 2208 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 110 "Order.ag" #-} + _lhsIo_newtypes + {-# LINE 2214 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 114 "Order.ag" #-} + _lhsIo_rename + {-# LINE 2220 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 113 "Order.ag" #-} + _lhsIo_sem + {-# LINE 2226 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 112 "Order.ag" #-} + _lhsIo_sig + {-# LINE 2232 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 119 "Order.ag" #-} + _lhsIo_unbox + {-# LINE 2238 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_wantvisit = + ({-# LINE 115 "Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 2244 "Order.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 118 "Order.ag" #-} + _lhsIprefix + {-# LINE 2250 "Order.hs" #-} + ) + -- copy rule (chain) + _tlOvcount = + ({-# LINE 258 "Order.ag" #-} + _hdIvcount + {-# LINE 2256 "Order.hs" #-} + ) + ( _hdIacount,_hdIadditionalDep,_hdIaranges,_hdIaroundDep,_hdIcNonterminal,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdImergeDep,_hdInAutoRules,_hdInExplicitRules,_hdInonts,_hdIntattrs,_hdIrules,_hdIvcount) = + hd_ _hdOacount _hdOallnts _hdOaroundMap _hdOcInterfaceMap _hdOcVisitsMap _hdOmanualAttrDepMap _hdOmergeMap _hdOo_case _hdOo_cata _hdOo_data _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOvcount + ( _tlIacount,_tlIadditionalDep,_tlIaranges,_tlIaroundDep,_tlIcNonterminals,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlImergeDep,_tlInAutoRules,_tlInExplicitRules,_tlInonts,_tlIntattrs,_tlIrules,_tlIvcount) = + tl_ _tlOacount _tlOallnts _tlOaroundMap _tlOcInterfaceMap _tlOcVisitsMap _tlOmanualAttrDepMap _tlOmergeMap _tlOo_case _tlOo_cata _tlOo_data _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOvcount + in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))) ) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ _lhsIacount + _lhsIallnts + _lhsIaroundMap + _lhsIcInterfaceMap + _lhsIcVisitsMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_data + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIvcount -> + (let _lhsOcNonterminals :: CNonterminals + _lhsOadditionalDep :: (Seq Edge) + _lhsOaranges :: (Seq (Int,Int,Int)) + _lhsOaroundDep :: (Seq Edge) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _lhsOntattrs :: (Seq (Vertex,NTAttr)) + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOacount :: Int + _lhsOvcount :: Int + -- "Order.ag"(line 622, column 12) + _lhsOcNonterminals = + ({-# LINE 622 "Order.ag" #-} + [] + {-# LINE 2303 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 283, column 60) + _lhsOadditionalDep = + ({-# LINE 283 "Order.ag" #-} + Seq.empty + {-# LINE 2309 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 500, column 36) + _lhsOaranges = + ({-# LINE 500 "Order.ag" #-} + Seq.empty + {-# LINE 2315 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 404, column 24) + _lhsOaroundDep = + ({-# LINE 404 "Order.ag" #-} + Seq.empty + {-# LINE 2321 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 269, column 33) + _lhsOdirectDep = + ({-# LINE 269 "Order.ag" #-} + Seq.empty + {-# LINE 2327 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + Seq.empty + {-# LINE 2333 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 312, column 31) + _lhsOinstDep = + ({-# LINE 312 "Order.ag" #-} + Seq.empty + {-# LINE 2339 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 367, column 18) + _lhsOmergeDep = + ({-# LINE 367 "Order.ag" #-} + Seq.empty + {-# LINE 2345 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + 0 + {-# LINE 2351 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + 0 + {-# LINE 2357 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 517, column 43) + _lhsOnonts = + ({-# LINE 517 "Order.ag" #-} + [] + {-# LINE 2363 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 499, column 35) + _lhsOntattrs = + ({-# LINE 499 "Order.ag" #-} + Seq.empty + {-# LINE 2369 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 259, column 18) + _lhsOrules = + ({-# LINE 259 "Order.ag" #-} + Seq.empty + {-# LINE 2375 "Order.hs" #-} + ) + -- copy rule (chain) + _lhsOacount = + ({-# LINE 499 "Order.ag" #-} + _lhsIacount + {-# LINE 2381 "Order.hs" #-} + ) + -- copy rule (chain) + _lhsOvcount = + ({-# LINE 258 "Order.ag" #-} + _lhsIvcount + {-# LINE 2387 "Order.hs" #-} + ) + in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allTypeSigs : Map Identifier Type + altAttrs : Map AltAttr Vertex + con : Identifier + inh : Attributes + nt : Identifier + syn : Attributes + synthesized attributes: + copy : SELF + errors : Seq Error + gathAltAttrs : [AltAttr] + instVars : [Identifier] + locVars : [Identifier] + patternAttrs : [(Identifier,Identifier,Bool,Patterns)] + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern ((Map Identifier Type) -> + (Map AltAttr Vertex) -> + Identifier -> + Attributes -> + Identifier -> + Attributes -> + ( Pattern ,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)]))) +data Inh_Pattern = Inh_Pattern {allTypeSigs_Inh_Pattern :: !((Map Identifier Type)),altAttrs_Inh_Pattern :: !((Map AltAttr Vertex)),con_Inh_Pattern :: !(Identifier),inh_Inh_Pattern :: !(Attributes),nt_Inh_Pattern :: !(Identifier),syn_Inh_Pattern :: !(Attributes)} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern ),errors_Syn_Pattern :: !((Seq Error)),gathAltAttrs_Syn_Pattern :: !(([AltAttr])),instVars_Syn_Pattern :: !(([Identifier])),locVars_Syn_Pattern :: !(([Identifier])),patternAttrs_Syn_Pattern :: !(([(Identifier,Identifier,Bool,Patterns)]))} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn ) = + (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) = sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn + in (Syn_Pattern _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _lhsOlocVars :: ([Identifier]) + _lhsOinstVars :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOcopy :: Pattern + _patOallTypeSigs :: (Map Identifier Type) + _patOaltAttrs :: (Map AltAttr Vertex) + _patOcon :: Identifier + _patOinh :: Attributes + _patOnt :: Identifier + _patOsyn :: Attributes + _partsOallTypeSigs :: (Map Identifier Type) + _partsOaltAttrs :: (Map AltAttr Vertex) + _partsOcon :: Identifier + _partsOinh :: Attributes + _partsOnt :: Identifier + _partsOsyn :: Attributes + _patIcopy :: Pattern + _patIerrors :: (Seq Error) + _patIgathAltAttrs :: ([AltAttr]) + _patIinstVars :: ([Identifier]) + _patIlocVars :: ([Identifier]) + _patIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _partsIcopy :: Patterns + _partsIerrors :: (Seq Error) + _partsIgathAltAttrs :: ([AltAttr]) + _partsIinstVars :: ([Identifier]) + _partsIlocVars :: ([Identifier]) + _partsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + -- "Order.ag"(line 184, column 12) + _lhsOgathAltAttrs = + ({-# LINE 184 "Order.ag" #-} + [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)] + {-# LINE 2509 "Order.hs" #-} + ) + -- "Order.ag"(line 252, column 12) + _lhsOpatternAttrs = + ({-# LINE 252 "Order.ag" #-} + [(field_,attr_,(field_ == _LOC || field_ == _INST),_partsIcopy)] + {-# LINE 2515 "Order.hs" #-} + ) + -- "Order.ag"(line 680, column 14) + _lhsOlocVars = + ({-# LINE 680 "Order.ag" #-} + if field_ == _LOC + then [attr_] + else [] + {-# LINE 2523 "Order.hs" #-} + ) + -- "Order.ag"(line 683, column 14) + _lhsOinstVars = + ({-# LINE 683 "Order.ag" #-} + if field_ == _INST + then [attr_] + else [] + {-# LINE 2531 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _patIerrors Seq.>< _partsIerrors + {-# LINE 2537 "Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 2543 "Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2549 "Order.hs" #-} + ) + -- copy rule (down) + _patOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 2555 "Order.hs" #-} + ) + -- copy rule (down) + _patOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 2561 "Order.hs" #-} + ) + -- copy rule (down) + _patOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 2567 "Order.hs" #-} + ) + -- copy rule (down) + _patOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 2573 "Order.hs" #-} + ) + -- copy rule (down) + _patOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 2579 "Order.hs" #-} + ) + -- copy rule (down) + _patOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 2585 "Order.hs" #-} + ) + -- copy rule (down) + _partsOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 2591 "Order.hs" #-} + ) + -- copy rule (down) + _partsOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 2597 "Order.hs" #-} + ) + -- copy rule (down) + _partsOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 2603 "Order.hs" #-} + ) + -- copy rule (down) + _partsOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 2609 "Order.hs" #-} + ) + -- copy rule (down) + _partsOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 2615 "Order.hs" #-} + ) + -- copy rule (down) + _partsOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 2621 "Order.hs" #-} + ) + ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) = + pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn + ( _partsIcopy,_partsIerrors,_partsIgathAltAttrs,_partsIinstVars,_partsIlocVars,_partsIpatternAttrs) = + parts_ _partsOallTypeSigs _partsOaltAttrs _partsOcon _partsOinh _partsOnt _partsOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _lhsOcopy :: Pattern + _patsOallTypeSigs :: (Map Identifier Type) + _patsOaltAttrs :: (Map AltAttr Vertex) + _patsOcon :: Identifier + _patsOinh :: Attributes + _patsOnt :: Identifier + _patsOsyn :: Attributes + _patsIcopy :: Patterns + _patsIerrors :: (Seq Error) + _patsIgathAltAttrs :: ([AltAttr]) + _patsIinstVars :: ([Identifier]) + _patsIlocVars :: ([Identifier]) + _patsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _patsIerrors + {-# LINE 2660 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + _patsIgathAltAttrs + {-# LINE 2666 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + _patsIinstVars + {-# LINE 2672 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + _patsIlocVars + {-# LINE 2678 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 249, column 42) + _lhsOpatternAttrs = + ({-# LINE 249 "Order.ag" #-} + _patsIpatternAttrs + {-# LINE 2684 "Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 2690 "Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2696 "Order.hs" #-} + ) + -- copy rule (down) + _patsOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 2702 "Order.hs" #-} + ) + -- copy rule (down) + _patsOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 2708 "Order.hs" #-} + ) + -- copy rule (down) + _patsOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 2714 "Order.hs" #-} + ) + -- copy rule (down) + _patsOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 2720 "Order.hs" #-} + ) + -- copy rule (down) + _patsOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 2726 "Order.hs" #-} + ) + -- copy rule (down) + _patsOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 2732 "Order.hs" #-} + ) + ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) = + pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _lhsOcopy :: Pattern + _patOallTypeSigs :: (Map Identifier Type) + _patOaltAttrs :: (Map AltAttr Vertex) + _patOcon :: Identifier + _patOinh :: Attributes + _patOnt :: Identifier + _patOsyn :: Attributes + _patIcopy :: Pattern + _patIerrors :: (Seq Error) + _patIgathAltAttrs :: ([AltAttr]) + _patIinstVars :: ([Identifier]) + _patIlocVars :: ([Identifier]) + _patIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _patIerrors + {-# LINE 2768 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + _patIgathAltAttrs + {-# LINE 2774 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + _patIinstVars + {-# LINE 2780 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + _patIlocVars + {-# LINE 2786 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 249, column 42) + _lhsOpatternAttrs = + ({-# LINE 249 "Order.ag" #-} + _patIpatternAttrs + {-# LINE 2792 "Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 2798 "Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2804 "Order.hs" #-} + ) + -- copy rule (down) + _patOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 2810 "Order.hs" #-} + ) + -- copy rule (down) + _patOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 2816 "Order.hs" #-} + ) + -- copy rule (down) + _patOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 2822 "Order.hs" #-} + ) + -- copy rule (down) + _patOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 2828 "Order.hs" #-} + ) + -- copy rule (down) + _patOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 2834 "Order.hs" #-} + ) + -- copy rule (down) + _patOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 2840 "Order.hs" #-} + ) + ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) = + pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _lhsOcopy :: Pattern + _patsOallTypeSigs :: (Map Identifier Type) + _patsOaltAttrs :: (Map AltAttr Vertex) + _patsOcon :: Identifier + _patsOinh :: Attributes + _patsOnt :: Identifier + _patsOsyn :: Attributes + _patsIcopy :: Patterns + _patsIerrors :: (Seq Error) + _patsIgathAltAttrs :: ([AltAttr]) + _patsIinstVars :: ([Identifier]) + _patsIlocVars :: ([Identifier]) + _patsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _patsIerrors + {-# LINE 2877 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + _patsIgathAltAttrs + {-# LINE 2883 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + _patsIinstVars + {-# LINE 2889 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + _patsIlocVars + {-# LINE 2895 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 249, column 42) + _lhsOpatternAttrs = + ({-# LINE 249 "Order.ag" #-} + _patsIpatternAttrs + {-# LINE 2901 "Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 2907 "Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2913 "Order.hs" #-} + ) + -- copy rule (down) + _patsOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 2919 "Order.hs" #-} + ) + -- copy rule (down) + _patsOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 2925 "Order.hs" #-} + ) + -- copy rule (down) + _patsOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 2931 "Order.hs" #-} + ) + -- copy rule (down) + _patsOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 2937 "Order.hs" #-} + ) + -- copy rule (down) + _patsOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 2943 "Order.hs" #-} + ) + -- copy rule (down) + _patsOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 2949 "Order.hs" #-} + ) + ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) = + pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _lhsOcopy :: Pattern + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + Seq.empty + {-# LINE 2973 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + [] + {-# LINE 2979 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + [] + {-# LINE 2985 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + [] + {-# LINE 2991 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 249, column 42) + _lhsOpatternAttrs = + ({-# LINE 249 "Order.ag" #-} + [] + {-# LINE 2997 "Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 3003 "Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3009 "Order.hs" #-} + ) + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allTypeSigs : Map Identifier Type + altAttrs : Map AltAttr Vertex + con : Identifier + inh : Attributes + nt : Identifier + syn : Attributes + synthesized attributes: + copy : SELF + errors : Seq Error + gathAltAttrs : [AltAttr] + instVars : [Identifier] + locVars : [Identifier] + patternAttrs : [(Identifier,Identifier,Bool,Patterns)] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 ((Map Identifier Type) -> + (Map AltAttr Vertex) -> + Identifier -> + Attributes -> + Identifier -> + Attributes -> + ( Patterns ,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)]))) +data Inh_Patterns = Inh_Patterns {allTypeSigs_Inh_Patterns :: !((Map Identifier Type)),altAttrs_Inh_Patterns :: !((Map AltAttr Vertex)),con_Inh_Patterns :: !(Identifier),inh_Inh_Patterns :: !(Attributes),nt_Inh_Patterns :: !(Identifier),syn_Inh_Patterns :: !(Attributes)} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns ),errors_Syn_Patterns :: !((Seq Error)),gathAltAttrs_Syn_Patterns :: !(([AltAttr])),instVars_Syn_Patterns :: !(([Identifier])),locVars_Syn_Patterns :: !(([Identifier])),patternAttrs_Syn_Patterns :: !(([(Identifier,Identifier,Bool,Patterns)]))} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn ) = + (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) = sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn + in (Syn_Patterns _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _lhsOcopy :: Patterns + _hdOallTypeSigs :: (Map Identifier Type) + _hdOaltAttrs :: (Map AltAttr Vertex) + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOnt :: Identifier + _hdOsyn :: Attributes + _tlOallTypeSigs :: (Map Identifier Type) + _tlOaltAttrs :: (Map AltAttr Vertex) + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOnt :: Identifier + _tlOsyn :: Attributes + _hdIcopy :: Pattern + _hdIerrors :: (Seq Error) + _hdIgathAltAttrs :: ([AltAttr]) + _hdIinstVars :: ([Identifier]) + _hdIlocVars :: ([Identifier]) + _hdIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _tlIcopy :: Patterns + _tlIerrors :: (Seq Error) + _tlIgathAltAttrs :: ([AltAttr]) + _tlIinstVars :: ([Identifier]) + _tlIlocVars :: ([Identifier]) + _tlIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 3104 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + _hdIgathAltAttrs ++ _tlIgathAltAttrs + {-# LINE 3110 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + _hdIinstVars ++ _tlIinstVars + {-# LINE 3116 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + _hdIlocVars ++ _tlIlocVars + {-# LINE 3122 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 249, column 42) + _lhsOpatternAttrs = + ({-# LINE 249 "Order.ag" #-} + _hdIpatternAttrs ++ _tlIpatternAttrs + {-# LINE 3128 "Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 3134 "Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3140 "Order.hs" #-} + ) + -- copy rule (down) + _hdOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 3146 "Order.hs" #-} + ) + -- copy rule (down) + _hdOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 3152 "Order.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 3158 "Order.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 3164 "Order.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 3170 "Order.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 3176 "Order.hs" #-} + ) + -- copy rule (down) + _tlOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 3182 "Order.hs" #-} + ) + -- copy rule (down) + _tlOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 3188 "Order.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 3194 "Order.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 3200 "Order.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 3206 "Order.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 3212 "Order.hs" #-} + ) + ( _hdIcopy,_hdIerrors,_hdIgathAltAttrs,_hdIinstVars,_hdIlocVars,_hdIpatternAttrs) = + hd_ _hdOallTypeSigs _hdOaltAttrs _hdOcon _hdOinh _hdOnt _hdOsyn + ( _tlIcopy,_tlIerrors,_tlIgathAltAttrs,_tlIinstVars,_tlIlocVars,_tlIpatternAttrs) = + tl_ _tlOallTypeSigs _tlOaltAttrs _tlOcon _tlOinh _tlOnt _tlOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _lhsOcopy :: Patterns + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + Seq.empty + {-# LINE 3237 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + [] + {-# LINE 3243 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + [] + {-# LINE 3249 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + [] + {-# LINE 3255 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 249, column 42) + _lhsOpatternAttrs = + ({-# LINE 249 "Order.ag" #-} + [] + {-# LINE 3261 "Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 3267 "Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3273 "Order.hs" #-} + ) + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) ) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + aroundMap : Map ConstructorIdent (Map Identifier [Expression]) + cVisitsMap : CVisitsMap + inh : Attributes + manualAttrDepMap : AttrOrderMap + mergeMap : Map ConstructorIdent (Map Identifier (Identifier,[Identifier])) + nt : Identifier + o_case : Bool + o_cata : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_unbox : Bool + o_wantvisit : Bool + prefix : String + syn : Attributes + chained attribute: + vcount : Int + synthesized attributes: + additionalDep : Seq Edge + aroundDep : Seq Edge + cProduction : CProduction + cons : [ConstructorIdent] + directDep : Seq Edge + errors : Seq Error + instDep : Seq Edge + mergeDep : Seq Edge + nAutoRules : Int + nExplicitRules : Int + rules : Seq (Vertex,CRule) + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + visit 0: + local gathAltAttrs : _ + local altAttrs : _ + local inhRules : _ + local gathRules : _ + local manualDeps : _ + local mergeMap : _ + local mergeDep1 : _ + local mergeDep2 : _ + local aroundMap : _ + local aroundDep1 : _ + local aroundDep2 : _ + local cVisits : _ + local allfields : _ + local attrs : _ + local inhnames : _ + local synnames : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _children _rules _typeSigs ) = + (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) +-- semantic domain +newtype T_Production = T_Production (([Identifier]) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + CVisitsMap -> + Attributes -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> + Identifier -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Attributes -> + Int -> + ( (Seq Edge),(Seq Edge),CProduction,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq Edge),Int,Int,(Seq (Vertex,CRule)),Int)) +data Inh_Production = Inh_Production {allnts_Inh_Production :: !(([Identifier])),aroundMap_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),cVisitsMap_Inh_Production :: !(CVisitsMap),inh_Inh_Production :: !(Attributes),manualAttrDepMap_Inh_Production :: !(AttrOrderMap),mergeMap_Inh_Production :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))),nt_Inh_Production :: !(Identifier),o_case_Inh_Production :: !(Bool),o_cata_Inh_Production :: !(Bool),o_dovisit_Inh_Production :: !(Bool),o_newtypes_Inh_Production :: !(Bool),o_rename_Inh_Production :: !(Bool),o_sem_Inh_Production :: !(Bool),o_sig_Inh_Production :: !(Bool),o_unbox_Inh_Production :: !(Bool),o_wantvisit_Inh_Production :: !(Bool),prefix_Inh_Production :: !(String),syn_Inh_Production :: !(Attributes),vcount_Inh_Production :: !(Int)} +data Syn_Production = Syn_Production {additionalDep_Syn_Production :: !((Seq Edge)),aroundDep_Syn_Production :: !((Seq Edge)),cProduction_Syn_Production :: !(CProduction),cons_Syn_Production :: !(([ConstructorIdent])),directDep_Syn_Production :: !((Seq Edge)),errors_Syn_Production :: !((Seq Error)),instDep_Syn_Production :: !((Seq Edge)),mergeDep_Syn_Production :: !((Seq Edge)),nAutoRules_Syn_Production :: !(Int),nExplicitRules_Syn_Production :: !(Int),rules_Syn_Production :: !((Seq (Vertex,CRule))),vcount_Syn_Production :: !(Int)} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem ) (Inh_Production _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount ) = + (let ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount) = sem _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount + in (Syn_Production _lhsOadditionalDep _lhsOaroundDep _lhsOcProduction _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount )) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = + (T_Production (\ _lhsIallnts + _lhsIaroundMap + _lhsIcVisitsMap + _lhsIinh + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIvcount -> + (let _childrenOcon :: Identifier + _rulesOcon :: Identifier + _rulesOchildNts :: (Map Identifier NontermIdent) + _rulesOchildInhs :: (Map Identifier Attributes) + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOvcount :: Int + _lhsOadditionalDep :: (Seq Edge) + _rulesOsynsOfChildren :: (Map Identifier Attributes) + _rulesOinhsOfChildren :: (Map Identifier Attributes) + _lhsOmergeDep :: (Seq Edge) + _lhsOaroundDep :: (Seq Edge) + _lhsOcons :: ([ConstructorIdent]) + _typeSigsOtypeSigs :: (Map Identifier Type) + _rulesOallTypeSigs :: (Map Identifier Type) + _lhsOcProduction :: CProduction + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _childrenOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _childrenOallnts :: ([Identifier]) + _childrenOattrs :: ([(Identifier,Identifier)]) + _childrenOinh :: Attributes + _childrenOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _childrenOnt :: Identifier + _childrenOo_unbox :: Bool + _childrenOsyn :: Attributes + _rulesOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _rulesOallnts :: ([Identifier]) + _rulesOaltAttrs :: (Map AltAttr Vertex) + _rulesOattrs :: ([(Identifier,Identifier)]) + _rulesOinh :: Attributes + _rulesOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _rulesOnt :: Identifier + _rulesOo_case :: Bool + _rulesOo_cata :: Bool + _rulesOo_dovisit :: Bool + _rulesOo_newtypes :: Bool + _rulesOo_rename :: Bool + _rulesOo_sem :: Bool + _rulesOo_sig :: Bool + _rulesOo_wantvisit :: Bool + _rulesOprefix :: String + _rulesOsyn :: Attributes + _childrenIattributes :: ([(Identifier,Attributes,Attributes)]) + _childrenIcollectChildrenInhs :: (Map Identifier Attributes ) + _childrenIcollectChildrenSyns :: (Map Identifier Attributes ) + _childrenIerrors :: (Seq Error) + _childrenIfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _childrenIgathAltAttrs :: ([AltAttr]) + _childrenIgathRules :: (Seq CRule) + _childrenIinhs :: (Seq (Identifier,Attributes)) + _childrenInts :: (Seq (Identifier,NontermIdent)) + _childrenIsinglevisits :: ([CRule]) + _childrenIterminals :: ([Identifier]) + _rulesIdirectDep :: (Seq Edge) + _rulesIerrors :: (Seq Error) + _rulesIgathAltAttrs :: ([AltAttr]) + _rulesIgathRules :: (Seq CRule) + _rulesIinstDep :: (Seq Edge) + _rulesIinstVars :: ([Identifier]) + _rulesIlocVars :: ([Identifier]) + _rulesInAutoRules :: Int + _rulesInExplicitRules :: Int + _typeSigsItypeSigs :: (Map Identifier Type) + -- "Order.ag"(line 93, column 16) + _childrenOcon = + ({-# LINE 93 "Order.ag" #-} + con_ + {-# LINE 3465 "Order.hs" #-} + ) + -- "Order.ag"(line 95, column 16) + _rulesOcon = + ({-# LINE 95 "Order.ag" #-} + con_ + {-# LINE 3471 "Order.hs" #-} + ) + -- "Order.ag"(line 172, column 18) + _gathAltAttrs = + ({-# LINE 172 "Order.ag" #-} + [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ] + ++ _childrenIgathAltAttrs + ++ _rulesIgathAltAttrs + {-# LINE 3479 "Order.hs" #-} + ) + -- "Order.ag"(line 188, column 17) + _altAttrs = + ({-# LINE 188 "Order.ag" #-} + Map.fromList (zip _gathAltAttrs [_lhsIvcount..]) + {-# LINE 3485 "Order.hs" #-} + ) + -- "Order.ag"(line 201, column 18) + _rulesOchildNts = + ({-# LINE 201 "Order.ag" #-} + Map.fromList (toList _childrenInts) + {-# LINE 3491 "Order.hs" #-} + ) + -- "Order.ag"(line 202, column 19) + _rulesOchildInhs = + ({-# LINE 202 "Order.ag" #-} + Map.fromList (toList _childrenIinhs) + {-# LINE 3497 "Order.hs" #-} + ) + -- "Order.ag"(line 208, column 18) + _inhRules = + ({-# LINE 208 "Order.ag" #-} + [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ] + {-# LINE 3503 "Order.hs" #-} + ) + -- "Order.ag"(line 209, column 19) + _gathRules = + ({-# LINE 209 "Order.ag" #-} + _inhRules ++ toList (_childrenIgathRules Seq.>< _rulesIgathRules) + {-# LINE 3509 "Order.hs" #-} + ) + -- "Order.ag"(line 263, column 18) + _lhsOrules = + ({-# LINE 263 "Order.ag" #-} + Seq.fromList (zip [_lhsIvcount..] _gathRules) + {-# LINE 3515 "Order.hs" #-} + ) + -- "Order.ag"(line 264, column 19) + _lhsOvcount = + ({-# LINE 264 "Order.ag" #-} + _lhsIvcount + length _gathRules + {-# LINE 3521 "Order.hs" #-} + ) + -- "Order.ag"(line 291, column 7) + _manualDeps = + ({-# LINE 291 "Order.ag" #-} + Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap + {-# LINE 3527 "Order.hs" #-} + ) + -- "Order.ag"(line 294, column 7) + _lhsOadditionalDep = + ({-# LINE 294 "Order.ag" #-} + Seq.fromList [ (vertex True occA, vertex False occB) + | Dependency occA occB <- _manualDeps + , let vertex inout (OccAttr child nm) + | child == _LOC = findWithErr2 (AltAttr _LOC nm True) _altAttrs + | otherwise = findWithErr2 (AltAttr child nm inout) _altAttrs + vertex _ (OccRule nm) + = findWithErr2 (AltAttr _LOC (Ident ("_rule_" ++ show nm) (getPos nm)) True) _altAttrs + ] + {-# LINE 3540 "Order.hs" #-} + ) + -- "Order.ag"(line 341, column 17) + _rulesOsynsOfChildren = + ({-# LINE 341 "Order.ag" #-} + _childrenIcollectChildrenSyns + {-# LINE 3546 "Order.hs" #-} + ) + -- "Order.ag"(line 342, column 17) + _rulesOinhsOfChildren = + ({-# LINE 342 "Order.ag" #-} + _childrenIcollectChildrenInhs + {-# LINE 3552 "Order.hs" #-} + ) + -- "Order.ag"(line 360, column 32) + _mergeMap = + ({-# LINE 360 "Order.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergeMap + {-# LINE 3558 "Order.hs" #-} + ) + -- "Order.ag"(line 371, column 7) + _lhsOmergeDep = + ({-# LINE 371 "Order.ag" #-} + _mergeDep1 Seq.>< _mergeDep2 + {-# LINE 3564 "Order.hs" #-} + ) + -- "Order.ag"(line 372, column 7) + _mergeDep1 = + ({-# LINE 372 "Order.ag" #-} + Seq.fromList $ + [ (childVert, synVert) + | childNm <- Map.keys _mergeMap + , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) + , let childNm' = Ident (show childNm ++ "_merge") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + synAttr = AltAttr childNm synNm True + childVert = findWithErr2 childAttr _altAttrs + synVert = findWithErr2 synAttr _altAttrs + ] + {-# LINE 3579 "Order.hs" #-} + ) + -- "Order.ag"(line 383, column 7) + _mergeDep2 = + ({-# LINE 383 "Order.ag" #-} + Seq.fromList $ + [ (mergedVert, sourceVert) + | (childNm, (_,cs)) <- Map.assocs _mergeMap + , c <- cs + , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) + , let sourceAttr = AltAttr childNm synNm True + mergedAttr = AltAttr c synNm True + sourceVert = findWithErr2 sourceAttr _altAttrs + mergedVert = findWithErr2 mergedAttr _altAttrs + ] + {-# LINE 3594 "Order.hs" #-} + ) + -- "Order.ag"(line 413, column 32) + _aroundMap = + ({-# LINE 413 "Order.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaroundMap + {-# LINE 3600 "Order.hs" #-} + ) + -- "Order.ag"(line 420, column 6) + _aroundDep1 = + ({-# LINE 420 "Order.ag" #-} + Seq.fromList $ + [ (childVert, synVert) + | childNm <- Map.keys _aroundMap + , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) + , let childNm' = Ident (show childNm ++ "_around") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + synAttr = AltAttr childNm synNm True + childVert = findWithErr2 childAttr _altAttrs + synVert = findWithErr2 synAttr _altAttrs + ] + {-# LINE 3615 "Order.hs" #-} + ) + -- "Order.ag"(line 431, column 6) + _aroundDep2 = + ({-# LINE 431 "Order.ag" #-} + Seq.fromList $ + [ (childVert, inhVert) + | childNm <- Map.keys _aroundMap + , inhNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenInhs) + , let childNm' = Ident (show childNm ++ "_around") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + inhAttr = AltAttr childNm inhNm False + childVert = findWithErr2 childAttr _altAttrs + inhVert = findWithErr2 inhAttr _altAttrs + ] + {-# LINE 3630 "Order.hs" #-} + ) + -- "Order.ag"(line 442, column 6) + _lhsOaroundDep = + ({-# LINE 442 "Order.ag" #-} + _aroundDep1 Seq.>< _aroundDep2 + {-# LINE 3636 "Order.hs" #-} + ) + -- "Order.ag"(line 522, column 18) + _lhsOcons = + ({-# LINE 522 "Order.ag" #-} + [con_] + {-# LINE 3642 "Order.hs" #-} + ) + -- "Order.ag"(line 529, column 16) + _typeSigsOtypeSigs = + ({-# LINE 529 "Order.ag" #-} + Map.empty + {-# LINE 3648 "Order.hs" #-} + ) + -- "Order.ag"(line 535, column 17) + _rulesOallTypeSigs = + ({-# LINE 535 "Order.ag" #-} + _typeSigsItypeSigs + {-# LINE 3654 "Order.hs" #-} + ) + -- "Order.ag"(line 603, column 17) + _cVisits = + ({-# LINE 603 "Order.ag" #-} + if _lhsIo_dovisit + then let prodsVisitsMap = findWithErr1 "Production.cVisits.nt" _lhsInt _lhsIcVisitsMap + visits = findWithErr1 "Production.cVisits.con" con_ prodsVisitsMap + in visits + else let vss = nubBy eqCRuleDefines _gathRules ++ _childrenIsinglevisits + in [CVisit _lhsIinh _lhsIsyn vss [] False] + {-# LINE 3665 "Order.hs" #-} + ) + -- "Order.ag"(line 629, column 18) + _lhsOcProduction = + ({-# LINE 629 "Order.ag" #-} + CProduction con_ _cVisits _childrenIfields _childrenIterminals + {-# LINE 3671 "Order.hs" #-} + ) + -- "Order.ag"(line 657, column 16) + _allfields = + ({-# LINE 657 "Order.ag" #-} + _childrenIfields + {-# LINE 3677 "Order.hs" #-} + ) + -- "Order.ag"(line 657, column 16) + _attrs = + ({-# LINE 658 "Order.ag" #-} + map ((,) _LOC) _rulesIlocVars ++ + map ((,) _INST) _rulesIinstVars ++ + map ((,) _LHS) _inhnames ++ + concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] + {-# LINE 3686 "Order.hs" #-} + ) + -- "Order.ag"(line 657, column 16) + _inhnames = + ({-# LINE 662 "Order.ag" #-} + Map.keys _lhsIinh + {-# LINE 3692 "Order.hs" #-} + ) + -- "Order.ag"(line 657, column 16) + _synnames = + ({-# LINE 663 "Order.ag" #-} + Map.keys _lhsIsyn + {-# LINE 3698 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 269, column 33) + _lhsOdirectDep = + ({-# LINE 269 "Order.ag" #-} + _rulesIdirectDep + {-# LINE 3704 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _childrenIerrors Seq.>< _rulesIerrors + {-# LINE 3710 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 312, column 31) + _lhsOinstDep = + ({-# LINE 312 "Order.ag" #-} + _rulesIinstDep + {-# LINE 3716 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + _rulesInAutoRules + {-# LINE 3722 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + _rulesInExplicitRules + {-# LINE 3728 "Order.hs" #-} + ) + -- copy rule (from local) + _childrenOallfields = + ({-# LINE 654 "Order.ag" #-} + _allfields + {-# LINE 3734 "Order.hs" #-} + ) + -- copy rule (down) + _childrenOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 3740 "Order.hs" #-} + ) + -- copy rule (from local) + _childrenOattrs = + ({-# LINE 654 "Order.ag" #-} + _attrs + {-# LINE 3746 "Order.hs" #-} + ) + -- copy rule (down) + _childrenOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 3752 "Order.hs" #-} + ) + -- copy rule (from local) + _childrenOmergeMap = + ({-# LINE 362 "Order.ag" #-} + _mergeMap + {-# LINE 3758 "Order.hs" #-} + ) + -- copy rule (down) + _childrenOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 3764 "Order.hs" #-} + ) + -- copy rule (down) + _childrenOo_unbox = + ({-# LINE 119 "Order.ag" #-} + _lhsIo_unbox + {-# LINE 3770 "Order.hs" #-} + ) + -- copy rule (down) + _childrenOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 3776 "Order.hs" #-} + ) + -- copy rule (from local) + _rulesOallfields = + ({-# LINE 654 "Order.ag" #-} + _allfields + {-# LINE 3782 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 3788 "Order.hs" #-} + ) + -- copy rule (from local) + _rulesOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _altAttrs + {-# LINE 3794 "Order.hs" #-} + ) + -- copy rule (from local) + _rulesOattrs = + ({-# LINE 654 "Order.ag" #-} + _attrs + {-# LINE 3800 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 3806 "Order.hs" #-} + ) + -- copy rule (from local) + _rulesOmergeMap = + ({-# LINE 362 "Order.ag" #-} + _mergeMap + {-# LINE 3812 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 3818 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_case = + ({-# LINE 117 "Order.ag" #-} + _lhsIo_case + {-# LINE 3824 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_cata = + ({-# LINE 111 "Order.ag" #-} + _lhsIo_cata + {-# LINE 3830 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _lhsIo_dovisit + {-# LINE 3836 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_newtypes = + ({-# LINE 110 "Order.ag" #-} + _lhsIo_newtypes + {-# LINE 3842 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_rename = + ({-# LINE 114 "Order.ag" #-} + _lhsIo_rename + {-# LINE 3848 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_sem = + ({-# LINE 113 "Order.ag" #-} + _lhsIo_sem + {-# LINE 3854 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_sig = + ({-# LINE 112 "Order.ag" #-} + _lhsIo_sig + {-# LINE 3860 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_wantvisit = + ({-# LINE 115 "Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 3866 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOprefix = + ({-# LINE 118 "Order.ag" #-} + _lhsIprefix + {-# LINE 3872 "Order.hs" #-} + ) + -- copy rule (down) + _rulesOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 3878 "Order.hs" #-} + ) + ( _childrenIattributes,_childrenIcollectChildrenInhs,_childrenIcollectChildrenSyns,_childrenIerrors,_childrenIfields,_childrenIgathAltAttrs,_childrenIgathRules,_childrenIinhs,_childrenInts,_childrenIsinglevisits,_childrenIterminals) = + children_ _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOmergeMap _childrenOnt _childrenOo_unbox _childrenOsyn + ( _rulesIdirectDep,_rulesIerrors,_rulesIgathAltAttrs,_rulesIgathRules,_rulesIinstDep,_rulesIinstVars,_rulesIlocVars,_rulesInAutoRules,_rulesInExplicitRules) = + rules_ _rulesOallTypeSigs _rulesOallfields _rulesOallnts _rulesOaltAttrs _rulesOattrs _rulesOchildInhs _rulesOchildNts _rulesOcon _rulesOinh _rulesOinhsOfChildren _rulesOmergeMap _rulesOnt _rulesOo_case _rulesOo_cata _rulesOo_dovisit _rulesOo_newtypes _rulesOo_rename _rulesOo_sem _rulesOo_sig _rulesOo_wantvisit _rulesOprefix _rulesOsyn _rulesOsynsOfChildren + ( _typeSigsItypeSigs) = + typeSigs_ _typeSigsOtypeSigs + in ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount))) ) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + aroundMap : Map ConstructorIdent (Map Identifier [Expression]) + cVisitsMap : CVisitsMap + inh : Attributes + manualAttrDepMap : AttrOrderMap + mergeMap : Map ConstructorIdent (Map Identifier (Identifier,[Identifier])) + nt : Identifier + o_case : Bool + o_cata : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_unbox : Bool + o_wantvisit : Bool + prefix : String + syn : Attributes + chained attribute: + vcount : Int + synthesized attributes: + additionalDep : Seq Edge + aroundDep : Seq Edge + cProductions : CProductions + cons : [ConstructorIdent] + directDep : Seq Edge + errors : Seq Error + instDep : Seq Edge + mergeDep : Seq Edge + nAutoRules : Int + nExplicitRules : Int + rules : Seq (Vertex,CRule) + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) +-- semantic domain +newtype T_Productions = T_Productions (([Identifier]) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + CVisitsMap -> + Attributes -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> + Identifier -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Attributes -> + Int -> + ( (Seq Edge),(Seq Edge),CProductions,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq Edge),Int,Int,(Seq (Vertex,CRule)),Int)) +data Inh_Productions = Inh_Productions {allnts_Inh_Productions :: !(([Identifier])),aroundMap_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),cVisitsMap_Inh_Productions :: !(CVisitsMap),inh_Inh_Productions :: !(Attributes),manualAttrDepMap_Inh_Productions :: !(AttrOrderMap),mergeMap_Inh_Productions :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))),nt_Inh_Productions :: !(Identifier),o_case_Inh_Productions :: !(Bool),o_cata_Inh_Productions :: !(Bool),o_dovisit_Inh_Productions :: !(Bool),o_newtypes_Inh_Productions :: !(Bool),o_rename_Inh_Productions :: !(Bool),o_sem_Inh_Productions :: !(Bool),o_sig_Inh_Productions :: !(Bool),o_unbox_Inh_Productions :: !(Bool),o_wantvisit_Inh_Productions :: !(Bool),prefix_Inh_Productions :: !(String),syn_Inh_Productions :: !(Attributes),vcount_Inh_Productions :: !(Int)} +data Syn_Productions = Syn_Productions {additionalDep_Syn_Productions :: !((Seq Edge)),aroundDep_Syn_Productions :: !((Seq Edge)),cProductions_Syn_Productions :: !(CProductions),cons_Syn_Productions :: !(([ConstructorIdent])),directDep_Syn_Productions :: !((Seq Edge)),errors_Syn_Productions :: !((Seq Error)),instDep_Syn_Productions :: !((Seq Edge)),mergeDep_Syn_Productions :: !((Seq Edge)),nAutoRules_Syn_Productions :: !(Int),nExplicitRules_Syn_Productions :: !(Int),rules_Syn_Productions :: !((Seq (Vertex,CRule))),vcount_Syn_Productions :: !(Int)} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem ) (Inh_Productions _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount ) = + (let ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount) = sem _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount + in (Syn_Productions _lhsOadditionalDep _lhsOaroundDep _lhsOcProductions _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount )) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = + (T_Productions (\ _lhsIallnts + _lhsIaroundMap + _lhsIcVisitsMap + _lhsIinh + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIvcount -> + (let _lhsOcProductions :: CProductions + _lhsOadditionalDep :: (Seq Edge) + _lhsOaroundDep :: (Seq Edge) + _lhsOcons :: ([ConstructorIdent]) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOvcount :: Int + _hdOallnts :: ([Identifier]) + _hdOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _hdOcVisitsMap :: CVisitsMap + _hdOinh :: Attributes + _hdOmanualAttrDepMap :: AttrOrderMap + _hdOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _hdOnt :: Identifier + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_dovisit :: Bool + _hdOo_newtypes :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_unbox :: Bool + _hdOo_wantvisit :: Bool + _hdOprefix :: String + _hdOsyn :: Attributes + _hdOvcount :: Int + _tlOallnts :: ([Identifier]) + _tlOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _tlOcVisitsMap :: CVisitsMap + _tlOinh :: Attributes + _tlOmanualAttrDepMap :: AttrOrderMap + _tlOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _tlOnt :: Identifier + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_dovisit :: Bool + _tlOo_newtypes :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_unbox :: Bool + _tlOo_wantvisit :: Bool + _tlOprefix :: String + _tlOsyn :: Attributes + _tlOvcount :: Int + _hdIadditionalDep :: (Seq Edge) + _hdIaroundDep :: (Seq Edge) + _hdIcProduction :: CProduction + _hdIcons :: ([ConstructorIdent]) + _hdIdirectDep :: (Seq Edge) + _hdIerrors :: (Seq Error) + _hdIinstDep :: (Seq Edge) + _hdImergeDep :: (Seq Edge) + _hdInAutoRules :: Int + _hdInExplicitRules :: Int + _hdIrules :: (Seq (Vertex,CRule)) + _hdIvcount :: Int + _tlIadditionalDep :: (Seq Edge) + _tlIaroundDep :: (Seq Edge) + _tlIcProductions :: CProductions + _tlIcons :: ([ConstructorIdent]) + _tlIdirectDep :: (Seq Edge) + _tlIerrors :: (Seq Error) + _tlIinstDep :: (Seq Edge) + _tlImergeDep :: (Seq Edge) + _tlInAutoRules :: Int + _tlInExplicitRules :: Int + _tlIrules :: (Seq (Vertex,CRule)) + _tlIvcount :: Int + -- "Order.ag"(line 626, column 12) + _lhsOcProductions = + ({-# LINE 626 "Order.ag" #-} + _hdIcProduction : _tlIcProductions + {-# LINE 4064 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 283, column 60) + _lhsOadditionalDep = + ({-# LINE 283 "Order.ag" #-} + _hdIadditionalDep Seq.>< _tlIadditionalDep + {-# LINE 4070 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 404, column 24) + _lhsOaroundDep = + ({-# LINE 404 "Order.ag" #-} + _hdIaroundDep Seq.>< _tlIaroundDep + {-# LINE 4076 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 520, column 40) + _lhsOcons = + ({-# LINE 520 "Order.ag" #-} + _hdIcons ++ _tlIcons + {-# LINE 4082 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 269, column 33) + _lhsOdirectDep = + ({-# LINE 269 "Order.ag" #-} + _hdIdirectDep Seq.>< _tlIdirectDep + {-# LINE 4088 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 4094 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 312, column 31) + _lhsOinstDep = + ({-# LINE 312 "Order.ag" #-} + _hdIinstDep Seq.>< _tlIinstDep + {-# LINE 4100 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 367, column 18) + _lhsOmergeDep = + ({-# LINE 367 "Order.ag" #-} + _hdImergeDep Seq.>< _tlImergeDep + {-# LINE 4106 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + _hdInAutoRules + _tlInAutoRules + {-# LINE 4112 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + _hdInExplicitRules + _tlInExplicitRules + {-# LINE 4118 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 259, column 18) + _lhsOrules = + ({-# LINE 259 "Order.ag" #-} + _hdIrules Seq.>< _tlIrules + {-# LINE 4124 "Order.hs" #-} + ) + -- copy rule (up) + _lhsOvcount = + ({-# LINE 258 "Order.ag" #-} + _tlIvcount + {-# LINE 4130 "Order.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 4136 "Order.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 410 "Order.ag" #-} + _lhsIaroundMap + {-# LINE 4142 "Order.hs" #-} + ) + -- copy rule (down) + _hdOcVisitsMap = + ({-# LINE 601 "Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 4148 "Order.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 4154 "Order.hs" #-} + ) + -- copy rule (down) + _hdOmanualAttrDepMap = + ({-# LINE 283 "Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 4160 "Order.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 357 "Order.ag" #-} + _lhsImergeMap + {-# LINE 4166 "Order.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 4172 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 117 "Order.ag" #-} + _lhsIo_case + {-# LINE 4178 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 111 "Order.ag" #-} + _lhsIo_cata + {-# LINE 4184 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _lhsIo_dovisit + {-# LINE 4190 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 110 "Order.ag" #-} + _lhsIo_newtypes + {-# LINE 4196 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 114 "Order.ag" #-} + _lhsIo_rename + {-# LINE 4202 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 113 "Order.ag" #-} + _lhsIo_sem + {-# LINE 4208 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 112 "Order.ag" #-} + _lhsIo_sig + {-# LINE 4214 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 119 "Order.ag" #-} + _lhsIo_unbox + {-# LINE 4220 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_wantvisit = + ({-# LINE 115 "Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 4226 "Order.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 118 "Order.ag" #-} + _lhsIprefix + {-# LINE 4232 "Order.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 4238 "Order.hs" #-} + ) + -- copy rule (down) + _hdOvcount = + ({-# LINE 258 "Order.ag" #-} + _lhsIvcount + {-# LINE 4244 "Order.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 4250 "Order.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 410 "Order.ag" #-} + _lhsIaroundMap + {-# LINE 4256 "Order.hs" #-} + ) + -- copy rule (down) + _tlOcVisitsMap = + ({-# LINE 601 "Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 4262 "Order.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 4268 "Order.hs" #-} + ) + -- copy rule (down) + _tlOmanualAttrDepMap = + ({-# LINE 283 "Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 4274 "Order.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 357 "Order.ag" #-} + _lhsImergeMap + {-# LINE 4280 "Order.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 4286 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 117 "Order.ag" #-} + _lhsIo_case + {-# LINE 4292 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 111 "Order.ag" #-} + _lhsIo_cata + {-# LINE 4298 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _lhsIo_dovisit + {-# LINE 4304 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 110 "Order.ag" #-} + _lhsIo_newtypes + {-# LINE 4310 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 114 "Order.ag" #-} + _lhsIo_rename + {-# LINE 4316 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 113 "Order.ag" #-} + _lhsIo_sem + {-# LINE 4322 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 112 "Order.ag" #-} + _lhsIo_sig + {-# LINE 4328 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 119 "Order.ag" #-} + _lhsIo_unbox + {-# LINE 4334 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_wantvisit = + ({-# LINE 115 "Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 4340 "Order.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 118 "Order.ag" #-} + _lhsIprefix + {-# LINE 4346 "Order.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 4352 "Order.hs" #-} + ) + -- copy rule (chain) + _tlOvcount = + ({-# LINE 258 "Order.ag" #-} + _hdIvcount + {-# LINE 4358 "Order.hs" #-} + ) + ( _hdIadditionalDep,_hdIaroundDep,_hdIcProduction,_hdIcons,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdImergeDep,_hdInAutoRules,_hdInExplicitRules,_hdIrules,_hdIvcount) = + hd_ _hdOallnts _hdOaroundMap _hdOcVisitsMap _hdOinh _hdOmanualAttrDepMap _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOsyn _hdOvcount + ( _tlIadditionalDep,_tlIaroundDep,_tlIcProductions,_tlIcons,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlImergeDep,_tlInAutoRules,_tlInExplicitRules,_tlIrules,_tlIvcount) = + tl_ _tlOallnts _tlOaroundMap _tlOcVisitsMap _tlOinh _tlOmanualAttrDepMap _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOsyn _tlOvcount + in ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount))) ) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ _lhsIallnts + _lhsIaroundMap + _lhsIcVisitsMap + _lhsIinh + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIvcount -> + (let _lhsOcProductions :: CProductions + _lhsOadditionalDep :: (Seq Edge) + _lhsOaroundDep :: (Seq Edge) + _lhsOcons :: ([ConstructorIdent]) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOvcount :: Int + -- "Order.ag"(line 627, column 12) + _lhsOcProductions = + ({-# LINE 627 "Order.ag" #-} + [] + {-# LINE 4402 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 283, column 60) + _lhsOadditionalDep = + ({-# LINE 283 "Order.ag" #-} + Seq.empty + {-# LINE 4408 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 404, column 24) + _lhsOaroundDep = + ({-# LINE 404 "Order.ag" #-} + Seq.empty + {-# LINE 4414 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 520, column 40) + _lhsOcons = + ({-# LINE 520 "Order.ag" #-} + [] + {-# LINE 4420 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 269, column 33) + _lhsOdirectDep = + ({-# LINE 269 "Order.ag" #-} + Seq.empty + {-# LINE 4426 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + Seq.empty + {-# LINE 4432 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 312, column 31) + _lhsOinstDep = + ({-# LINE 312 "Order.ag" #-} + Seq.empty + {-# LINE 4438 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 367, column 18) + _lhsOmergeDep = + ({-# LINE 367 "Order.ag" #-} + Seq.empty + {-# LINE 4444 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + 0 + {-# LINE 4450 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + 0 + {-# LINE 4456 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 259, column 18) + _lhsOrules = + ({-# LINE 259 "Order.ag" #-} + Seq.empty + {-# LINE 4462 "Order.hs" #-} + ) + -- copy rule (chain) + _lhsOvcount = + ({-# LINE 258 "Order.ag" #-} + _lhsIvcount + {-# LINE 4468 "Order.hs" #-} + ) + in ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount))) ) +-- Rule -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allTypeSigs : Map Identifier Type + allfields : [(Identifier,Type,Maybe (Maybe Type))] + allnts : [Identifier] + altAttrs : Map AltAttr Vertex + attrs : [(Identifier,Identifier)] + childInhs : Map Identifier Attributes + childNts : Map Identifier NontermIdent + con : Identifier + inh : Attributes + inhsOfChildren : Map Identifier Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + o_case : Bool + o_cata : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_wantvisit : Bool + prefix : String + syn : Attributes + synsOfChildren : Map Identifier Attributes + synthesized attributes: + directDep : Seq Edge + errors : Seq Error + gathAltAttrs : [AltAttr] + gathRules : Seq CRule + instDep : Seq Edge + instVars : [Identifier] + locVars : [Identifier] + nAutoRules : Int + nExplicitRules : Int + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + visit 0: + local defines : _ + local gathRules : _ + local instDep1 : _ + local instDep2 : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) +-- semantic domain +newtype T_Rule = T_Rule ((Map Identifier Type) -> + ([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + (Map AltAttr Vertex) -> + ([(Identifier,Identifier)]) -> + (Map Identifier Attributes) -> + (Map Identifier NontermIdent) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Attributes -> + (Map Identifier Attributes) -> + ( (Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier]),Int,Int)) +data Inh_Rule = Inh_Rule {allTypeSigs_Inh_Rule :: !((Map Identifier Type)),allfields_Inh_Rule :: !(([(Identifier,Type,Maybe (Maybe Type))])),allnts_Inh_Rule :: !(([Identifier])),altAttrs_Inh_Rule :: !((Map AltAttr Vertex)),attrs_Inh_Rule :: !(([(Identifier,Identifier)])),childInhs_Inh_Rule :: !((Map Identifier Attributes)),childNts_Inh_Rule :: !((Map Identifier NontermIdent)),con_Inh_Rule :: !(Identifier),inh_Inh_Rule :: !(Attributes),inhsOfChildren_Inh_Rule :: !((Map Identifier Attributes)),mergeMap_Inh_Rule :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Rule :: !(Identifier),o_case_Inh_Rule :: !(Bool),o_cata_Inh_Rule :: !(Bool),o_dovisit_Inh_Rule :: !(Bool),o_newtypes_Inh_Rule :: !(Bool),o_rename_Inh_Rule :: !(Bool),o_sem_Inh_Rule :: !(Bool),o_sig_Inh_Rule :: !(Bool),o_wantvisit_Inh_Rule :: !(Bool),prefix_Inh_Rule :: !(String),syn_Inh_Rule :: !(Attributes),synsOfChildren_Inh_Rule :: !((Map Identifier Attributes))} +data Syn_Rule = Syn_Rule {directDep_Syn_Rule :: !((Seq Edge)),errors_Syn_Rule :: !((Seq Error)),gathAltAttrs_Syn_Rule :: !(([AltAttr])),gathRules_Syn_Rule :: !((Seq CRule)),instDep_Syn_Rule :: !((Seq Edge)),instVars_Syn_Rule :: !(([Identifier])),locVars_Syn_Rule :: !(([Identifier])),nAutoRules_Syn_Rule :: !(Int),nExplicitRules_Syn_Rule :: !(Int)} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren ) = + (let ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules) = sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren + in (Syn_Rule _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules )) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = + (T_Rule (\ _lhsIallTypeSigs + _lhsIallfields + _lhsIallnts + _lhsIaltAttrs + _lhsIattrs + _lhsIchildInhs + _lhsIchildNts + _lhsIcon + _lhsIinh + _lhsIinhsOfChildren + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynsOfChildren -> + (let _lhsOnExplicitRules :: Int + _lhsOnAutoRules :: Int + _lhsOdirectDep :: (Seq Edge) + _lhsOinstDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _patternOallTypeSigs :: (Map Identifier Type) + _patternOaltAttrs :: (Map AltAttr Vertex) + _patternOcon :: Identifier + _patternOinh :: Attributes + _patternOnt :: Identifier + _patternOsyn :: Attributes + _rhsOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _rhsOallnts :: ([Identifier]) + _rhsOattrs :: ([(Identifier,Identifier)]) + _rhsOcon :: Identifier + _rhsOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _rhsOnt :: Identifier + _patternIcopy :: Pattern + _patternIerrors :: (Seq Error) + _patternIgathAltAttrs :: ([AltAttr]) + _patternIinstVars :: ([Identifier]) + _patternIlocVars :: ([Identifier]) + _patternIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) + _rhsIallRhsVars :: (Set (Identifier,Identifier)) + _rhsIcopy :: Expression + _rhsIerrors :: (Seq Error) + _rhsItextLines :: ([String]) + _rhsIusedAttrs :: ([(Identifier,Identifier)]) + _rhsIusedFields :: ([Identifier]) + _rhsIusedLocals :: ([Identifier]) + -- "Order.ag"(line 64, column 11) + _lhsOnExplicitRules = + ({-# LINE 64 "Order.ag" #-} + if explicit_ + then 1 + else 0 + {-# LINE 4631 "Order.hs" #-} + ) + -- "Order.ag"(line 67, column 11) + _lhsOnAutoRules = + ({-# LINE 67 "Order.ag" #-} + if startsWith "use rule" origin_ || startsWith "copy rule" origin_ + then 1 + else 0 + {-# LINE 4639 "Order.hs" #-} + ) + -- "Order.ag"(line 217, column 12) + _defines = + ({-# LINE 217 "Order.ag" #-} + let tp field attr parts | field == _LOC || field == _INST + = case parts of + [] -> Map.lookup attr _lhsIallTypeSigs + _ -> (sequence (map typ parts)) >>= (haskellTupel . map (substSelf _lhsInt)) + | field == _LHS = Map.lookup attr _lhsIsyn + | otherwise = Map.lookup attr (findWithErr1 "Rule.defines.tp" field _lhsIchildInhs) + typ :: Pattern -> Maybe Type + typ (Alias field attr _ parts) = tp field attr parts + typ (Underscore _) = Nothing + typ _ = Nothing + in Map.fromList [ (findWithErr1 "Rule.defines" aa _lhsIaltAttrs, (field,attr,(tp field attr parts))) + | (field,attr,isLocalOrInst,parts) <- _patternIpatternAttrs + , let aa = AltAttr field attr isLocalOrInst + ] + {-# LINE 4658 "Order.hs" #-} + ) + -- "Order.ag"(line 233, column 12) + _gathRules = + ({-# LINE 233 "Order.ag" #-} + let childnt field = Map.lookup field _lhsIchildNts + in Seq.fromList [ CRule attr False True _lhsInt _lhsIcon field (childnt field) tp _patternIcopy _rhsItextLines _defines owrt_ origin_ _rhsIallRhsVars explicit_ mbName_ + | (field,attr,tp) <- Map.elems _defines + ] + {-# LINE 4667 "Order.hs" #-} + ) + -- "Order.ag"(line 271, column 12) + _lhsOdirectDep = + ({-# LINE 271 "Order.ag" #-} + let defined = Map.keys _defines + used = [ Map.lookup (AltAttr field attr True) _lhsIaltAttrs | (field,attr) <- _rhsIusedAttrs] + ++ [ Map.lookup (AltAttr _LOC attr True) _lhsIaltAttrs | attr <- _rhsIusedLocals ++ _rhsIusedFields ] + in Seq.fromList [ (x,y) | Just x <- used, y <- defined ] + {-# LINE 4676 "Order.hs" #-} + ) + -- "Order.ag"(line 315, column 6) + _instDep1 = + ({-# LINE 315 "Order.ag" #-} + Seq.fromList $ + [ (instVert, synVert) + | (field,instNm,_) <- Map.elems _defines + , field == _INST + , synNm <- Map.keys (findWithErr2 instNm _lhsIsynsOfChildren) + , let instAttr = AltAttr _INST instNm True + synAttr = AltAttr instNm synNm True + instVert = findWithErr2 instAttr _lhsIaltAttrs + synVert = findWithErr2 synAttr _lhsIaltAttrs + ] + {-# LINE 4691 "Order.hs" #-} + ) + -- "Order.ag"(line 326, column 6) + _instDep2 = + ({-# LINE 326 "Order.ag" #-} + Seq.fromList $ + [ (instVert, inhVert) + | (field,instNm,_) <- Map.elems _defines + , field == _INST + , inhNm <- Map.keys (findWithErr2 instNm _lhsIinhsOfChildren) + , let instAttr = AltAttr _INST instNm True + inhAttr = AltAttr instNm inhNm False + instVert = findWithErr2 instAttr _lhsIaltAttrs + inhVert = findWithErr2 inhAttr _lhsIaltAttrs + ] + {-# LINE 4706 "Order.hs" #-} + ) + -- "Order.ag"(line 337, column 6) + _lhsOinstDep = + ({-# LINE 337 "Order.ag" #-} + _instDep1 Seq.>< _instDep2 + {-# LINE 4712 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _patternIerrors Seq.>< _rhsIerrors + {-# LINE 4718 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + _patternIgathAltAttrs + {-# LINE 4724 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 206, column 23) + _lhsOgathRules = + ({-# LINE 206 "Order.ag" #-} + _gathRules + {-# LINE 4730 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + _patternIinstVars + {-# LINE 4736 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + _patternIlocVars + {-# LINE 4742 "Order.hs" #-} + ) + -- copy rule (down) + _patternOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 4748 "Order.hs" #-} + ) + -- copy rule (down) + _patternOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 4754 "Order.hs" #-} + ) + -- copy rule (down) + _patternOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 4760 "Order.hs" #-} + ) + -- copy rule (down) + _patternOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 4766 "Order.hs" #-} + ) + -- copy rule (down) + _patternOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 4772 "Order.hs" #-} + ) + -- copy rule (down) + _patternOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 4778 "Order.hs" #-} + ) + -- copy rule (down) + _rhsOallfields = + ({-# LINE 448 "Order.ag" #-} + _lhsIallfields + {-# LINE 4784 "Order.hs" #-} + ) + -- copy rule (down) + _rhsOallnts = + ({-# LINE 449 "Order.ag" #-} + _lhsIallnts + {-# LINE 4790 "Order.hs" #-} + ) + -- copy rule (down) + _rhsOattrs = + ({-# LINE 450 "Order.ag" #-} + _lhsIattrs + {-# LINE 4796 "Order.hs" #-} + ) + -- copy rule (down) + _rhsOcon = + ({-# LINE 447 "Order.ag" #-} + _lhsIcon + {-# LINE 4802 "Order.hs" #-} + ) + -- copy rule (down) + _rhsOmergeMap = + ({-# LINE 362 "Order.ag" #-} + _lhsImergeMap + {-# LINE 4808 "Order.hs" #-} + ) + -- copy rule (down) + _rhsOnt = + ({-# LINE 447 "Order.ag" #-} + _lhsInt + {-# LINE 4814 "Order.hs" #-} + ) + ( _patternIcopy,_patternIerrors,_patternIgathAltAttrs,_patternIinstVars,_patternIlocVars,_patternIpatternAttrs) = + pattern_ _patternOallTypeSigs _patternOaltAttrs _patternOcon _patternOinh _patternOnt _patternOsyn + ( _rhsIallRhsVars,_rhsIcopy,_rhsIerrors,_rhsItextLines,_rhsIusedAttrs,_rhsIusedFields,_rhsIusedLocals) = + rhs_ _rhsOallfields _rhsOallnts _rhsOattrs _rhsOcon _rhsOmergeMap _rhsOnt + in ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules))) ) +-- Rules ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allTypeSigs : Map Identifier Type + allfields : [(Identifier,Type,Maybe (Maybe Type))] + allnts : [Identifier] + altAttrs : Map AltAttr Vertex + attrs : [(Identifier,Identifier)] + childInhs : Map Identifier Attributes + childNts : Map Identifier NontermIdent + con : Identifier + inh : Attributes + inhsOfChildren : Map Identifier Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + o_case : Bool + o_cata : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_wantvisit : Bool + prefix : String + syn : Attributes + synsOfChildren : Map Identifier Attributes + synthesized attributes: + directDep : Seq Edge + errors : Seq Error + gathAltAttrs : [AltAttr] + gathRules : Seq CRule + instDep : Seq Edge + instVars : [Identifier] + locVars : [Identifier] + nAutoRules : Int + nExplicitRules : Int + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) +-- semantic domain +newtype T_Rules = T_Rules ((Map Identifier Type) -> + ([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + (Map AltAttr Vertex) -> + ([(Identifier,Identifier)]) -> + (Map Identifier Attributes) -> + (Map Identifier NontermIdent) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Attributes -> + (Map Identifier Attributes) -> + ( (Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier]),Int,Int)) +data Inh_Rules = Inh_Rules {allTypeSigs_Inh_Rules :: !((Map Identifier Type)),allfields_Inh_Rules :: !(([(Identifier,Type,Maybe (Maybe Type))])),allnts_Inh_Rules :: !(([Identifier])),altAttrs_Inh_Rules :: !((Map AltAttr Vertex)),attrs_Inh_Rules :: !(([(Identifier,Identifier)])),childInhs_Inh_Rules :: !((Map Identifier Attributes)),childNts_Inh_Rules :: !((Map Identifier NontermIdent)),con_Inh_Rules :: !(Identifier),inh_Inh_Rules :: !(Attributes),inhsOfChildren_Inh_Rules :: !((Map Identifier Attributes)),mergeMap_Inh_Rules :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Rules :: !(Identifier),o_case_Inh_Rules :: !(Bool),o_cata_Inh_Rules :: !(Bool),o_dovisit_Inh_Rules :: !(Bool),o_newtypes_Inh_Rules :: !(Bool),o_rename_Inh_Rules :: !(Bool),o_sem_Inh_Rules :: !(Bool),o_sig_Inh_Rules :: !(Bool),o_wantvisit_Inh_Rules :: !(Bool),prefix_Inh_Rules :: !(String),syn_Inh_Rules :: !(Attributes),synsOfChildren_Inh_Rules :: !((Map Identifier Attributes))} +data Syn_Rules = Syn_Rules {directDep_Syn_Rules :: !((Seq Edge)),errors_Syn_Rules :: !((Seq Error)),gathAltAttrs_Syn_Rules :: !(([AltAttr])),gathRules_Syn_Rules :: !((Seq CRule)),instDep_Syn_Rules :: !((Seq Edge)),instVars_Syn_Rules :: !(([Identifier])),locVars_Syn_Rules :: !(([Identifier])),nAutoRules_Syn_Rules :: !(Int),nExplicitRules_Syn_Rules :: !(Int)} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren ) = + (let ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules) = sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren + in (Syn_Rules _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules )) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) = + (T_Rules (\ _lhsIallTypeSigs + _lhsIallfields + _lhsIallnts + _lhsIaltAttrs + _lhsIattrs + _lhsIchildInhs + _lhsIchildNts + _lhsIcon + _lhsIinh + _lhsIinhsOfChildren + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynsOfChildren -> + (let _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinstDep :: (Seq Edge) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _hdOallTypeSigs :: (Map Identifier Type) + _hdOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _hdOallnts :: ([Identifier]) + _hdOaltAttrs :: (Map AltAttr Vertex) + _hdOattrs :: ([(Identifier,Identifier)]) + _hdOchildInhs :: (Map Identifier Attributes) + _hdOchildNts :: (Map Identifier NontermIdent) + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOinhsOfChildren :: (Map Identifier Attributes) + _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _hdOnt :: Identifier + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_dovisit :: Bool + _hdOo_newtypes :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_wantvisit :: Bool + _hdOprefix :: String + _hdOsyn :: Attributes + _hdOsynsOfChildren :: (Map Identifier Attributes) + _tlOallTypeSigs :: (Map Identifier Type) + _tlOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _tlOallnts :: ([Identifier]) + _tlOaltAttrs :: (Map AltAttr Vertex) + _tlOattrs :: ([(Identifier,Identifier)]) + _tlOchildInhs :: (Map Identifier Attributes) + _tlOchildNts :: (Map Identifier NontermIdent) + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOinhsOfChildren :: (Map Identifier Attributes) + _tlOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _tlOnt :: Identifier + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_dovisit :: Bool + _tlOo_newtypes :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_wantvisit :: Bool + _tlOprefix :: String + _tlOsyn :: Attributes + _tlOsynsOfChildren :: (Map Identifier Attributes) + _hdIdirectDep :: (Seq Edge) + _hdIerrors :: (Seq Error) + _hdIgathAltAttrs :: ([AltAttr]) + _hdIgathRules :: (Seq CRule) + _hdIinstDep :: (Seq Edge) + _hdIinstVars :: ([Identifier]) + _hdIlocVars :: ([Identifier]) + _hdInAutoRules :: Int + _hdInExplicitRules :: Int + _tlIdirectDep :: (Seq Edge) + _tlIerrors :: (Seq Error) + _tlIgathAltAttrs :: ([AltAttr]) + _tlIgathRules :: (Seq CRule) + _tlIinstDep :: (Seq Edge) + _tlIinstVars :: ([Identifier]) + _tlIlocVars :: ([Identifier]) + _tlInAutoRules :: Int + _tlInExplicitRules :: Int + -- use rule "Order.ag"(line 269, column 33) + _lhsOdirectDep = + ({-# LINE 269 "Order.ag" #-} + _hdIdirectDep Seq.>< _tlIdirectDep + {-# LINE 5006 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 5012 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + _hdIgathAltAttrs ++ _tlIgathAltAttrs + {-# LINE 5018 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 206, column 23) + _lhsOgathRules = + ({-# LINE 206 "Order.ag" #-} + _hdIgathRules Seq.>< _tlIgathRules + {-# LINE 5024 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 312, column 31) + _lhsOinstDep = + ({-# LINE 312 "Order.ag" #-} + _hdIinstDep Seq.>< _tlIinstDep + {-# LINE 5030 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + _hdIinstVars ++ _tlIinstVars + {-# LINE 5036 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + _hdIlocVars ++ _tlIlocVars + {-# LINE 5042 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + _hdInAutoRules + _tlInAutoRules + {-# LINE 5048 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + _hdInExplicitRules + _tlInExplicitRules + {-# LINE 5054 "Order.hs" #-} + ) + -- copy rule (down) + _hdOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 5060 "Order.hs" #-} + ) + -- copy rule (down) + _hdOallfields = + ({-# LINE 654 "Order.ag" #-} + _lhsIallfields + {-# LINE 5066 "Order.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 5072 "Order.hs" #-} + ) + -- copy rule (down) + _hdOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 5078 "Order.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 654 "Order.ag" #-} + _lhsIattrs + {-# LINE 5084 "Order.hs" #-} + ) + -- copy rule (down) + _hdOchildInhs = + ({-# LINE 199 "Order.ag" #-} + _lhsIchildInhs + {-# LINE 5090 "Order.hs" #-} + ) + -- copy rule (down) + _hdOchildNts = + ({-# LINE 198 "Order.ag" #-} + _lhsIchildNts + {-# LINE 5096 "Order.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 5102 "Order.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 5108 "Order.hs" #-} + ) + -- copy rule (down) + _hdOinhsOfChildren = + ({-# LINE 339 "Order.ag" #-} + _lhsIinhsOfChildren + {-# LINE 5114 "Order.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 362 "Order.ag" #-} + _lhsImergeMap + {-# LINE 5120 "Order.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 5126 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 117 "Order.ag" #-} + _lhsIo_case + {-# LINE 5132 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 111 "Order.ag" #-} + _lhsIo_cata + {-# LINE 5138 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _lhsIo_dovisit + {-# LINE 5144 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 110 "Order.ag" #-} + _lhsIo_newtypes + {-# LINE 5150 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 114 "Order.ag" #-} + _lhsIo_rename + {-# LINE 5156 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 113 "Order.ag" #-} + _lhsIo_sem + {-# LINE 5162 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 112 "Order.ag" #-} + _lhsIo_sig + {-# LINE 5168 "Order.hs" #-} + ) + -- copy rule (down) + _hdOo_wantvisit = + ({-# LINE 115 "Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 5174 "Order.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 118 "Order.ag" #-} + _lhsIprefix + {-# LINE 5180 "Order.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 5186 "Order.hs" #-} + ) + -- copy rule (down) + _hdOsynsOfChildren = + ({-# LINE 339 "Order.ag" #-} + _lhsIsynsOfChildren + {-# LINE 5192 "Order.hs" #-} + ) + -- copy rule (down) + _tlOallTypeSigs = + ({-# LINE 533 "Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 5198 "Order.hs" #-} + ) + -- copy rule (down) + _tlOallfields = + ({-# LINE 654 "Order.ag" #-} + _lhsIallfields + {-# LINE 5204 "Order.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 647 "Order.ag" #-} + _lhsIallnts + {-# LINE 5210 "Order.hs" #-} + ) + -- copy rule (down) + _tlOaltAttrs = + ({-# LINE 186 "Order.ag" #-} + _lhsIaltAttrs + {-# LINE 5216 "Order.hs" #-} + ) + -- copy rule (down) + _tlOattrs = + ({-# LINE 654 "Order.ag" #-} + _lhsIattrs + {-# LINE 5222 "Order.hs" #-} + ) + -- copy rule (down) + _tlOchildInhs = + ({-# LINE 199 "Order.ag" #-} + _lhsIchildInhs + {-# LINE 5228 "Order.hs" #-} + ) + -- copy rule (down) + _tlOchildNts = + ({-# LINE 198 "Order.ag" #-} + _lhsIchildNts + {-# LINE 5234 "Order.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 90 "Order.ag" #-} + _lhsIcon + {-# LINE 5240 "Order.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 89 "Order.ag" #-} + _lhsIinh + {-# LINE 5246 "Order.hs" #-} + ) + -- copy rule (down) + _tlOinhsOfChildren = + ({-# LINE 339 "Order.ag" #-} + _lhsIinhsOfChildren + {-# LINE 5252 "Order.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 362 "Order.ag" #-} + _lhsImergeMap + {-# LINE 5258 "Order.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 89 "Order.ag" #-} + _lhsInt + {-# LINE 5264 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 117 "Order.ag" #-} + _lhsIo_case + {-# LINE 5270 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 111 "Order.ag" #-} + _lhsIo_cata + {-# LINE 5276 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_dovisit = + ({-# LINE 116 "Order.ag" #-} + _lhsIo_dovisit + {-# LINE 5282 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 110 "Order.ag" #-} + _lhsIo_newtypes + {-# LINE 5288 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 114 "Order.ag" #-} + _lhsIo_rename + {-# LINE 5294 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 113 "Order.ag" #-} + _lhsIo_sem + {-# LINE 5300 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 112 "Order.ag" #-} + _lhsIo_sig + {-# LINE 5306 "Order.hs" #-} + ) + -- copy rule (down) + _tlOo_wantvisit = + ({-# LINE 115 "Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 5312 "Order.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 118 "Order.ag" #-} + _lhsIprefix + {-# LINE 5318 "Order.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 89 "Order.ag" #-} + _lhsIsyn + {-# LINE 5324 "Order.hs" #-} + ) + -- copy rule (down) + _tlOsynsOfChildren = + ({-# LINE 339 "Order.ag" #-} + _lhsIsynsOfChildren + {-# LINE 5330 "Order.hs" #-} + ) + ( _hdIdirectDep,_hdIerrors,_hdIgathAltAttrs,_hdIgathRules,_hdIinstDep,_hdIinstVars,_hdIlocVars,_hdInAutoRules,_hdInExplicitRules) = + hd_ _hdOallTypeSigs _hdOallfields _hdOallnts _hdOaltAttrs _hdOattrs _hdOchildInhs _hdOchildNts _hdOcon _hdOinh _hdOinhsOfChildren _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_wantvisit _hdOprefix _hdOsyn _hdOsynsOfChildren + ( _tlIdirectDep,_tlIerrors,_tlIgathAltAttrs,_tlIgathRules,_tlIinstDep,_tlIinstVars,_tlIlocVars,_tlInAutoRules,_tlInExplicitRules) = + tl_ _tlOallTypeSigs _tlOallfields _tlOallnts _tlOaltAttrs _tlOattrs _tlOchildInhs _tlOchildNts _tlOcon _tlOinh _tlOinhsOfChildren _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_wantvisit _tlOprefix _tlOsyn _tlOsynsOfChildren + in ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules))) ) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ _lhsIallTypeSigs + _lhsIallfields + _lhsIallnts + _lhsIaltAttrs + _lhsIattrs + _lhsIchildInhs + _lhsIchildNts + _lhsIcon + _lhsIinh + _lhsIinhsOfChildren + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynsOfChildren -> + (let _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinstDep :: (Seq Edge) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + -- use rule "Order.ag"(line 269, column 33) + _lhsOdirectDep = + ({-# LINE 269 "Order.ag" #-} + Seq.empty + {-# LINE 5375 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 84, column 70) + _lhsOerrors = + ({-# LINE 84 "Order.ag" #-} + Seq.empty + {-# LINE 5381 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 170, column 68) + _lhsOgathAltAttrs = + ({-# LINE 170 "Order.ag" #-} + [] + {-# LINE 5387 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 206, column 23) + _lhsOgathRules = + ({-# LINE 206 "Order.ag" #-} + Seq.empty + {-# LINE 5393 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 312, column 31) + _lhsOinstDep = + ({-# LINE 312 "Order.ag" #-} + Seq.empty + {-# LINE 5399 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 86) + _lhsOinstVars = + ({-# LINE 677 "Order.ag" #-} + [] + {-# LINE 5405 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 677, column 48) + _lhsOlocVars = + ({-# LINE 677 "Order.ag" #-} + [] + {-# LINE 5411 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnAutoRules = + ({-# LINE 61 "Order.ag" #-} + 0 + {-# LINE 5417 "Order.hs" #-} + ) + -- use rule "Order.ag"(line 61, column 105) + _lhsOnExplicitRules = + ({-# LINE 61 "Order.ag" #-} + 0 + {-# LINE 5423 "Order.hs" #-} + ) + in ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules))) ) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + chained attribute: + typeSigs : Map Identifier Type + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp ) = + (sem_TypeSig_TypeSig _name _tp ) +-- semantic domain +newtype T_TypeSig = T_TypeSig ((Map Identifier Type) -> + ( (Map Identifier Type))) +data Inh_TypeSig = Inh_TypeSig {typeSigs_Inh_TypeSig :: !((Map Identifier Type))} +data Syn_TypeSig = Syn_TypeSig {typeSigs_Syn_TypeSig :: !((Map Identifier Type))} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig _lhsItypeSigs ) = + (let ( _lhsOtypeSigs) = sem _lhsItypeSigs + in (Syn_TypeSig _lhsOtypeSigs )) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (\ _lhsItypeSigs -> + (let _lhsOtypeSigs :: (Map Identifier Type) + -- "Order.ag"(line 531, column 13) + _lhsOtypeSigs = + ({-# LINE 531 "Order.ag" #-} + Map.insert name_ tp_ _lhsItypeSigs + {-# LINE 5462 "Order.hs" #-} + ) + in ( _lhsOtypeSigs))) ) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + chained attribute: + typeSigs : Map Identifier Type + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs ((Map Identifier Type) -> + ( (Map Identifier Type))) +data Inh_TypeSigs = Inh_TypeSigs {typeSigs_Inh_TypeSigs :: !((Map Identifier Type))} +data Syn_TypeSigs = Syn_TypeSigs {typeSigs_Syn_TypeSigs :: !((Map Identifier Type))} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs _lhsItypeSigs ) = + (let ( _lhsOtypeSigs) = sem _lhsItypeSigs + in (Syn_TypeSigs _lhsOtypeSigs )) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) = + (T_TypeSigs (\ _lhsItypeSigs -> + (let _lhsOtypeSigs :: (Map Identifier Type) + _hdOtypeSigs :: (Map Identifier Type) + _tlOtypeSigs :: (Map Identifier Type) + _hdItypeSigs :: (Map Identifier Type) + _tlItypeSigs :: (Map Identifier Type) + -- copy rule (up) + _lhsOtypeSigs = + ({-# LINE 527 "Order.ag" #-} + _tlItypeSigs + {-# LINE 5506 "Order.hs" #-} + ) + -- copy rule (down) + _hdOtypeSigs = + ({-# LINE 527 "Order.ag" #-} + _lhsItypeSigs + {-# LINE 5512 "Order.hs" #-} + ) + -- copy rule (chain) + _tlOtypeSigs = + ({-# LINE 527 "Order.ag" #-} + _hdItypeSigs + {-# LINE 5518 "Order.hs" #-} + ) + ( _hdItypeSigs) = + hd_ _hdOtypeSigs + ( _tlItypeSigs) = + tl_ _tlOtypeSigs + in ( _lhsOtypeSigs))) ) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (\ _lhsItypeSigs -> + (let _lhsOtypeSigs :: (Map Identifier Type) + -- copy rule (chain) + _lhsOtypeSigs = + ({-# LINE 527 "Order.ag" #-} + _lhsItypeSigs + {-# LINE 5533 "Order.hs" #-} + ) + in ( _lhsOtypeSigs))) ) diff --git a/src-derived/Patterns.hs b/src-derived/Patterns.hs new file mode 100644 --- /dev/null +++ b/src-derived/Patterns.hs @@ -0,0 +1,64 @@ + + +-- UUAGC 0.9.38.1 (Patterns.ag) +module Patterns where +{-# LINE 2 "Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 11 "../src-derived/Patterns.hs" #-} +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : SELF + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +data Pattern = Alias (Identifier) (Identifier) (Pattern ) (Patterns ) + | Constr (ConstructorIdent) (Patterns ) + | Irrefutable (Pattern ) + | Product (Pos) (Patterns ) + | Underscore (Pos) + deriving ( Show) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : SELF + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +type Patterns = [Pattern ] diff --git a/src-derived/PrintCode.hs b/src-derived/PrintCode.hs new file mode 100644 --- /dev/null +++ b/src-derived/PrintCode.hs @@ -0,0 +1,4121 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.38.1 (PrintCode.ag) +module PrintCode where +{-# LINE 10 "PrintCode.ag" #-} + +import Char (isAlphaNum) +import Pretty +import Code +import Patterns +import Options +import CommonTypes (attrname, _LOC, getName, nullIdent) +import Data.List(intersperse) +import System.IO +import System.Directory +import CommonTypes(BlockInfo, BlockType(..), identifier) +{-# LINE 18 "../src-derived/PrintCode.hs" #-} + +{-# LINE 2 "./Code.ag" #-} + +import Pretty +import Patterns +import Data.List(partition) +import Data.Set(Set) +import qualified Data.Set as Set +import Data.Map(Map) +import qualified Data.Map as Map +{-# LINE 29 "../src-derived/PrintCode.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 36 "../src-derived/PrintCode.hs" #-} +{-# LINE 23 "PrintCode.ag" #-} + +type PP_Docs = [PP_Doc] +{-# LINE 40 "../src-derived/PrintCode.hs" #-} + +{-# LINE 27 "PrintCode.ag" #-} + +ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeqH = ppMultiSeq' (>#<) + +ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeqV = ppMultiSeq' (>-<) + +ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeq' next strictArgs expr + = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs +{-# LINE 53 "../src-derived/PrintCode.hs" #-} + +{-# LINE 296 "PrintCode.ag" #-} + + +reallySimple :: String -> Bool +reallySimple = and . map (\x -> isAlphaNum x || x=='_') + +ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps +ppTuple False pps = "(" >|< pp_block " " ")" "," pps +ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps +ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps + +{-# LINE 66 "../src-derived/PrintCode.hs" #-} + +{-# LINE 395 "PrintCode.ag" #-} + +locname' n = "_loc_" ++ getName n +{-# LINE 71 "../src-derived/PrintCode.hs" #-} + +{-# LINE 468 "PrintCode.ag" #-} + +renderDocs :: [PP_Doc] -> String +renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" +{-# LINE 77 "../src-derived/PrintCode.hs" #-} + +{-# LINE 515 "PrintCode.ag" #-} + +writeModule :: FilePath -> [PP_Doc] -> IO () +writeModule path docs + = do bExists <- doesFileExist path + if bExists + then do input <- readFile path + seq (length input) (return ()) + if input /= output + then dumpIt + else return () + else dumpIt + where + output = renderDocs docs + dumpIt = writeFile path output +{-# LINE 94 "../src-derived/PrintCode.hs" #-} + +{-# LINE 145 "./Code.ag" #-} + +-- Unboxed tuples +-- unbox Whether unboxed tuples are wanted or not +-- inh The inherited attributes. +-- If there are none, no unboxing can take place, +-- because in that case the semantic function (a top-level identifier) would have an unboxed type. +-- Of course we can't have an unboxed 1-tuple +mkTupleExpr :: Bool -> Bool -> Exprs -> Expr +mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs + | otherwise = UnboxedTupleExpr exprs +mkTupleType :: Bool -> Bool -> Types -> Type +mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps + | otherwise = UnboxedTupleType tps +mkTupleLhs :: Bool -> Bool -> [String] -> Lhs +mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps + | otherwise = UnboxedTupleLhs comps +{-# LINE 113 "../src-derived/PrintCode.hs" #-} +-- CaseAlt ----------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pps : PP_Docs + alternatives: + alternative CaseAlt: + child left : Lhs + child expr : Expr +-} +-- cata +sem_CaseAlt :: CaseAlt -> + T_CaseAlt +sem_CaseAlt !(CaseAlt _left _expr ) = + (sem_CaseAlt_CaseAlt (sem_Lhs _left ) (sem_Expr _expr ) ) +-- semantic domain +newtype T_CaseAlt = T_CaseAlt (Bool -> + Options -> + String -> + ( PP_Docs)) +data Inh_CaseAlt = Inh_CaseAlt {nested_Inh_CaseAlt :: !(Bool),options_Inh_CaseAlt :: !(Options),outputfile_Inh_CaseAlt :: !(String)} +data Syn_CaseAlt = Syn_CaseAlt {pps_Syn_CaseAlt :: !(PP_Docs)} +wrap_CaseAlt :: T_CaseAlt -> + Inh_CaseAlt -> + Syn_CaseAlt +wrap_CaseAlt !(T_CaseAlt sem ) !(Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile ) = + (let ( !_lhsOpps) = sem _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_CaseAlt _lhsOpps )) +sem_CaseAlt_CaseAlt :: T_Lhs -> + T_Expr -> + T_CaseAlt +sem_CaseAlt_CaseAlt !(T_Lhs left_ ) !(T_Expr expr_ ) = + (T_CaseAlt (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 155 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 160 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 165 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 170 "PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 175 "PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 180 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 418 "PrintCode.ag" #-} + False + {-# LINE 185 "PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of + { ( !_leftIpp) -> + (case (({-# LINE 218 "PrintCode.ag" #-} + ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] + {-# LINE 194 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }) })) ) +-- CaseAlts ---------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : CaseAlt + child tl : CaseAlts + alternative Nil: +-} +-- cata +sem_CaseAlts :: CaseAlts -> + T_CaseAlts +sem_CaseAlts !list = + (Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list) ) +-- semantic domain +newtype T_CaseAlts = T_CaseAlts (Bool -> + Options -> + String -> + ( PP_Docs)) +data Inh_CaseAlts = Inh_CaseAlts {nested_Inh_CaseAlts :: !(Bool),options_Inh_CaseAlts :: !(Options),outputfile_Inh_CaseAlts :: !(String)} +data Syn_CaseAlts = Syn_CaseAlts {pps_Syn_CaseAlts :: !(PP_Docs)} +wrap_CaseAlts :: T_CaseAlts -> + Inh_CaseAlts -> + Syn_CaseAlts +wrap_CaseAlts !(T_CaseAlts sem ) !(Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile ) = + (let ( !_lhsOpps) = sem _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_CaseAlts _lhsOpps )) +sem_CaseAlts_Cons :: T_CaseAlt -> + T_CaseAlts -> + T_CaseAlts +sem_CaseAlts_Cons !(T_CaseAlt hd_ ) !(T_CaseAlts tl_ ) = + (T_CaseAlts (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 240 "PrintCode.hs" #-} + )) of + { !_tlOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 245 "PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 55 "PrintCode.ag" #-} + _lhsInested + {-# LINE 250 "PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 255 "PrintCode.hs" #-} + )) of + { !_hdOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 260 "PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 55 "PrintCode.ag" #-} + _lhsInested + {-# LINE 265 "PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested _tlOoptions _tlOoutputfile ) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested _hdOoptions _hdOoutputfile ) of + { ( !_hdIpps) -> + (case (({-# LINE 68 "PrintCode.ag" #-} + _hdIpps ++ _tlIpps + {-# LINE 274 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) })) ) +sem_CaseAlts_Nil :: T_CaseAlts +sem_CaseAlts_Nil = + (T_CaseAlts (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 69 "PrintCode.ag" #-} + [] + {-# LINE 285 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- Chunk ------------------------------------------------------- +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + isDeclOfLet : Bool + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nested : Bool + options : Options + optionsLine : String + pragmaBlocks : String + textBlockMap : Map BlockInfo PP_Doc + textBlocks : PP_Doc + synthesized attributes: + appendCommon : [[PP_Doc]] + appendMain : [[PP_Doc]] + genSems : IO () + imports : [String] + pps : PP_Docs + alternatives: + alternative Chunk: + child name : {String} + child comment : Decl + child info : Decls + child dataDef : Decls + child cataFun : Decls + child semDom : Decls + child semWrapper : Decls + child semFunctions : Decls + child semNames : {[String]} + visit 0: + local outputfile : _ + local exports : _ +-} +-- cata +sem_Chunk :: Chunk -> + T_Chunk +sem_Chunk !(Chunk _name _comment _info _dataDef _cataFun _semDom _semWrapper _semFunctions _semNames ) = + (sem_Chunk_Chunk _name (sem_Decl _comment ) (sem_Decls _info ) (sem_Decls _dataDef ) (sem_Decls _cataFun ) (sem_Decls _semDom ) (sem_Decls _semWrapper ) (sem_Decls _semFunctions ) _semNames ) +-- semantic domain +newtype T_Chunk = T_Chunk (PP_Doc -> + Bool -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Bool -> + Options -> + String -> + String -> + (Map BlockInfo PP_Doc) -> + PP_Doc -> + ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs)) +data Inh_Chunk = Inh_Chunk {importBlocks_Inh_Chunk :: !(PP_Doc),isDeclOfLet_Inh_Chunk :: !(Bool),mainFile_Inh_Chunk :: !(String),mainName_Inh_Chunk :: !(String),moduleHeader_Inh_Chunk :: !((String -> String -> String -> Bool -> String)),nested_Inh_Chunk :: !(Bool),options_Inh_Chunk :: !(Options),optionsLine_Inh_Chunk :: !(String),pragmaBlocks_Inh_Chunk :: !(String),textBlockMap_Inh_Chunk :: !((Map BlockInfo PP_Doc)),textBlocks_Inh_Chunk :: !(PP_Doc)} +data Syn_Chunk = Syn_Chunk {appendCommon_Syn_Chunk :: !(([[PP_Doc]])),appendMain_Syn_Chunk :: !(([[PP_Doc]])),genSems_Syn_Chunk :: !((IO ())),imports_Syn_Chunk :: !(([String])),pps_Syn_Chunk :: !(PP_Docs)} +wrap_Chunk :: T_Chunk -> + Inh_Chunk -> + Syn_Chunk +wrap_Chunk !(T_Chunk sem ) !(Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) = + (let ( !_lhsOappendCommon,!_lhsOappendMain,!_lhsOgenSems,!_lhsOimports,!_lhsOpps) = sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks + in (Syn_Chunk _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps )) +sem_Chunk_Chunk :: String -> + T_Decl -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + ([String]) -> + T_Chunk +sem_Chunk_Chunk !name_ !(T_Decl comment_ ) !(T_Decls info_ ) !(T_Decls dataDef_ ) !(T_Decls cataFun_ ) !(T_Decls semDom_ ) !(T_Decls semWrapper_ ) !(T_Decls semFunctions_ ) !semNames_ = + (T_Chunk (\ (!_lhsIimportBlocks) + (!_lhsIisDeclOfLet) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case (({-# LINE 43 "PrintCode.ag" #-} + if sepSemMods _lhsIoptions + then _lhsImainFile ++ "_" ++ name_ ++ ".hs" + else _lhsImainFile ++ ".hs" + {-# LINE 377 "PrintCode.hs" #-} + )) of + { !_outputfile -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _outputfile + {-# LINE 382 "PrintCode.hs" #-} + )) of + { !_semDomOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 387 "PrintCode.hs" #-} + )) of + { !_semDomOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 392 "PrintCode.hs" #-} + )) of + { !_semDomOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 397 "PrintCode.hs" #-} + )) of + { !_semDomOisDeclOfLet -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _outputfile + {-# LINE 402 "PrintCode.hs" #-} + )) of + { !_dataDefOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 407 "PrintCode.hs" #-} + )) of + { !_dataDefOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 412 "PrintCode.hs" #-} + )) of + { !_dataDefOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 417 "PrintCode.hs" #-} + )) of + { !_dataDefOisDeclOfLet -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _outputfile + {-# LINE 422 "PrintCode.hs" #-} + )) of + { !_commentOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 427 "PrintCode.hs" #-} + )) of + { !_commentOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 432 "PrintCode.hs" #-} + )) of + { !_commentOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 437 "PrintCode.hs" #-} + )) of + { !_commentOisDeclOfLet -> + (case (semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile ) of + { ( !_semDomIpps) -> + (case (dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile ) of + { ( !_dataDefIpps) -> + (case (comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile ) of + { ( !_commentIpp) -> + (case (({-# LINE 482 "PrintCode.ag" #-} + [ [_commentIpp] + , _dataDefIpps + , _semDomIpps + ] + {-# LINE 451 "PrintCode.hs" #-} + )) of + { !_lhsOappendCommon -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _outputfile + {-# LINE 456 "PrintCode.hs" #-} + )) of + { !_semWrapperOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 461 "PrintCode.hs" #-} + )) of + { !_semWrapperOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 466 "PrintCode.hs" #-} + )) of + { !_semWrapperOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 471 "PrintCode.hs" #-} + )) of + { !_semWrapperOisDeclOfLet -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _outputfile + {-# LINE 476 "PrintCode.hs" #-} + )) of + { !_cataFunOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 481 "PrintCode.hs" #-} + )) of + { !_cataFunOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 486 "PrintCode.hs" #-} + )) of + { !_cataFunOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 491 "PrintCode.hs" #-} + )) of + { !_cataFunOisDeclOfLet -> + (case (semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile ) of + { ( !_semWrapperIpps) -> + (case (cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile ) of + { ( !_cataFunIpps) -> + (case (({-# LINE 487 "PrintCode.ag" #-} + [ [_commentIpp] + , _cataFunIpps + , _semWrapperIpps + ] + {-# LINE 503 "PrintCode.hs" #-} + )) of + { !_lhsOappendMain -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _outputfile + {-# LINE 508 "PrintCode.hs" #-} + )) of + { !_semFunctionsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 513 "PrintCode.hs" #-} + )) of + { !_semFunctionsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 518 "PrintCode.hs" #-} + )) of + { !_semFunctionsOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 523 "PrintCode.hs" #-} + )) of + { !_semFunctionsOisDeclOfLet -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _outputfile + {-# LINE 528 "PrintCode.hs" #-} + )) of + { !_infoOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 533 "PrintCode.hs" #-} + )) of + { !_infoOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 538 "PrintCode.hs" #-} + )) of + { !_infoOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 543 "PrintCode.hs" #-} + )) of + { !_infoOisDeclOfLet -> + (case (({-# LINE 513 "PrintCode.ag" #-} + concat $ intersperse "," semNames_ + {-# LINE 548 "PrintCode.hs" #-} + )) of + { !_exports -> + (case (semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile ) of + { ( !_semFunctionsIpps) -> + (case (info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile ) of + { ( !_infoIpps) -> + (case (({-# LINE 497 "PrintCode.ag" #-} + writeModule _outputfile + [ pp $ _lhsIpragmaBlocks + , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap + , pp $ _lhsIoptionsLine + , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True + , pp $ ("import " ++ _lhsImainName ++ "_common\n") + , pp $ Map.findWithDefault empty (BlockImport, Just $ identifier name_) _lhsItextBlockMap + , _commentIpp + , vlist_sep "" _infoIpps + , vlist_sep "" _semFunctionsIpps + , Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap + ] + {-# LINE 568 "PrintCode.hs" #-} + )) of + { !_lhsOgenSems -> + (case (({-# LINE 476 "PrintCode.ag" #-} + ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] + {-# LINE 573 "PrintCode.hs" #-} + )) of + { !_lhsOimports -> + (case (({-# LINE 96 "PrintCode.ag" #-} + _commentIpp + : _infoIpps + ++ _dataDefIpps + ++ _cataFunIpps + ++ _semDomIpps + ++ _semWrapperIpps + ++ _semFunctionsIpps + ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] + {-# LINE 585 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Chunks ------------------------------------------------------ +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + isDeclOfLet : Bool + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nested : Bool + options : Options + optionsLine : String + pragmaBlocks : String + textBlockMap : Map BlockInfo PP_Doc + textBlocks : PP_Doc + synthesized attributes: + appendCommon : [[PP_Doc]] + appendMain : [[PP_Doc]] + genSems : IO () + imports : [String] + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Chunk + child tl : Chunks + alternative Nil: +-} +-- cata +sem_Chunks :: Chunks -> + T_Chunks +sem_Chunks !list = + (Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list) ) +-- semantic domain +newtype T_Chunks = T_Chunks (PP_Doc -> + Bool -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Bool -> + Options -> + String -> + String -> + (Map BlockInfo PP_Doc) -> + PP_Doc -> + ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs)) +data Inh_Chunks = Inh_Chunks {importBlocks_Inh_Chunks :: !(PP_Doc),isDeclOfLet_Inh_Chunks :: !(Bool),mainFile_Inh_Chunks :: !(String),mainName_Inh_Chunks :: !(String),moduleHeader_Inh_Chunks :: !((String -> String -> String -> Bool -> String)),nested_Inh_Chunks :: !(Bool),options_Inh_Chunks :: !(Options),optionsLine_Inh_Chunks :: !(String),pragmaBlocks_Inh_Chunks :: !(String),textBlockMap_Inh_Chunks :: !((Map BlockInfo PP_Doc)),textBlocks_Inh_Chunks :: !(PP_Doc)} +data Syn_Chunks = Syn_Chunks {appendCommon_Syn_Chunks :: !(([[PP_Doc]])),appendMain_Syn_Chunks :: !(([[PP_Doc]])),genSems_Syn_Chunks :: !((IO ())),imports_Syn_Chunks :: !(([String])),pps_Syn_Chunks :: !(PP_Docs)} +wrap_Chunks :: T_Chunks -> + Inh_Chunks -> + Syn_Chunks +wrap_Chunks !(T_Chunks sem ) !(Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) = + (let ( !_lhsOappendCommon,!_lhsOappendMain,!_lhsOgenSems,!_lhsOimports,!_lhsOpps) = sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks + in (Syn_Chunks _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps )) +sem_Chunks_Cons :: T_Chunk -> + T_Chunks -> + T_Chunks +sem_Chunks_Cons !(T_Chunk hd_ ) !(T_Chunks tl_ ) = + (T_Chunks (\ (!_lhsIimportBlocks) + (!_lhsIisDeclOfLet) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 659 "PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 664 "PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 433 "PrintCode.ag" #-} + _lhsImainFile + {-# LINE 669 "PrintCode.hs" #-} + )) of + { !_tlOmainFile -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 674 "PrintCode.hs" #-} + )) of + { !_tlOisDeclOfLet -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 679 "PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 684 "PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (({-# LINE 433 "PrintCode.ag" #-} + _lhsImainFile + {-# LINE 689 "PrintCode.hs" #-} + )) of + { !_hdOmainFile -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 694 "PrintCode.hs" #-} + )) of + { !_hdOisDeclOfLet -> + (case (({-# LINE 430 "PrintCode.ag" #-} + _lhsItextBlocks + {-# LINE 699 "PrintCode.hs" #-} + )) of + { !_tlOtextBlocks -> + (case (({-# LINE 431 "PrintCode.ag" #-} + _lhsItextBlockMap + {-# LINE 704 "PrintCode.hs" #-} + )) of + { !_tlOtextBlockMap -> + (case (({-# LINE 429 "PrintCode.ag" #-} + _lhsIpragmaBlocks + {-# LINE 709 "PrintCode.hs" #-} + )) of + { !_tlOpragmaBlocks -> + (case (({-# LINE 432 "PrintCode.ag" #-} + _lhsIoptionsLine + {-# LINE 714 "PrintCode.hs" #-} + )) of + { !_tlOoptionsLine -> + (case (({-# LINE 435 "PrintCode.ag" #-} + _lhsImoduleHeader + {-# LINE 719 "PrintCode.hs" #-} + )) of + { !_tlOmoduleHeader -> + (case (({-# LINE 434 "PrintCode.ag" #-} + _lhsImainName + {-# LINE 724 "PrintCode.hs" #-} + )) of + { !_tlOmainName -> + (case (({-# LINE 428 "PrintCode.ag" #-} + _lhsIimportBlocks + {-# LINE 729 "PrintCode.hs" #-} + )) of + { !_tlOimportBlocks -> + (case (tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlockMap _tlOtextBlocks ) of + { ( !_tlIappendCommon,!_tlIappendMain,!_tlIgenSems,!_tlIimports,!_tlIpps) -> + (case (({-# LINE 430 "PrintCode.ag" #-} + _lhsItextBlocks + {-# LINE 736 "PrintCode.hs" #-} + )) of + { !_hdOtextBlocks -> + (case (({-# LINE 431 "PrintCode.ag" #-} + _lhsItextBlockMap + {-# LINE 741 "PrintCode.hs" #-} + )) of + { !_hdOtextBlockMap -> + (case (({-# LINE 429 "PrintCode.ag" #-} + _lhsIpragmaBlocks + {-# LINE 746 "PrintCode.hs" #-} + )) of + { !_hdOpragmaBlocks -> + (case (({-# LINE 432 "PrintCode.ag" #-} + _lhsIoptionsLine + {-# LINE 751 "PrintCode.hs" #-} + )) of + { !_hdOoptionsLine -> + (case (({-# LINE 435 "PrintCode.ag" #-} + _lhsImoduleHeader + {-# LINE 756 "PrintCode.hs" #-} + )) of + { !_hdOmoduleHeader -> + (case (({-# LINE 434 "PrintCode.ag" #-} + _lhsImainName + {-# LINE 761 "PrintCode.hs" #-} + )) of + { !_hdOmainName -> + (case (({-# LINE 428 "PrintCode.ag" #-} + _lhsIimportBlocks + {-# LINE 766 "PrintCode.hs" #-} + )) of + { !_hdOimportBlocks -> + (case (hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlockMap _hdOtextBlocks ) of + { ( !_hdIappendCommon,!_hdIappendMain,!_hdIgenSems,!_hdIimports,!_hdIpps) -> + (case (({-# LINE 478 "PrintCode.ag" #-} + _hdIappendCommon ++ _tlIappendCommon + {-# LINE 773 "PrintCode.hs" #-} + )) of + { !_lhsOappendCommon -> + (case (({-# LINE 478 "PrintCode.ag" #-} + _hdIappendMain ++ _tlIappendMain + {-# LINE 778 "PrintCode.hs" #-} + )) of + { !_lhsOappendMain -> + (case (({-# LINE 493 "PrintCode.ag" #-} + _hdIgenSems >> _tlIgenSems + {-# LINE 783 "PrintCode.hs" #-} + )) of + { !_lhsOgenSems -> + (case (({-# LINE 473 "PrintCode.ag" #-} + _hdIimports ++ _tlIimports + {-# LINE 788 "PrintCode.hs" #-} + )) of + { !_lhsOimports -> + (case (({-# LINE 88 "PrintCode.ag" #-} + _hdIpps ++ _tlIpps + {-# LINE 793 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Chunks_Nil :: T_Chunks +sem_Chunks_Nil = + (T_Chunks (\ (!_lhsIimportBlocks) + (!_lhsIisDeclOfLet) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case (({-# LINE 478 "PrintCode.ag" #-} + [] + {-# LINE 812 "PrintCode.hs" #-} + )) of + { !_lhsOappendCommon -> + (case (({-# LINE 478 "PrintCode.ag" #-} + [] + {-# LINE 817 "PrintCode.hs" #-} + )) of + { !_lhsOappendMain -> + (case (({-# LINE 493 "PrintCode.ag" #-} + return () + {-# LINE 822 "PrintCode.hs" #-} + )) of + { !_lhsOgenSems -> + (case (({-# LINE 473 "PrintCode.ag" #-} + [] + {-# LINE 827 "PrintCode.hs" #-} + )) of + { !_lhsOimports -> + (case (({-# LINE 89 "PrintCode.ag" #-} + [] + {-# LINE 832 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) }) }) }) }) })) ) +-- DataAlt ----------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + strictPre : PP_Doc + synthesized attribute: + pp : PP_Doc + alternatives: + alternative DataAlt: + child name : {String} + child args : Types + alternative Record: + child name : {String} + child args : NamedTypes +-} +-- cata +sem_DataAlt :: DataAlt -> + T_DataAlt +sem_DataAlt !(DataAlt _name _args ) = + (sem_DataAlt_DataAlt _name (sem_Types _args ) ) +sem_DataAlt !(Record _name _args ) = + (sem_DataAlt_Record _name (sem_NamedTypes _args ) ) +-- semantic domain +newtype T_DataAlt = T_DataAlt (Bool -> + PP_Doc -> + ( PP_Doc)) +data Inh_DataAlt = Inh_DataAlt {nested_Inh_DataAlt :: !(Bool),strictPre_Inh_DataAlt :: !(PP_Doc)} +data Syn_DataAlt = Syn_DataAlt {pp_Syn_DataAlt :: !(PP_Doc)} +wrap_DataAlt :: T_DataAlt -> + Inh_DataAlt -> + Syn_DataAlt +wrap_DataAlt !(T_DataAlt sem ) !(Inh_DataAlt _lhsInested _lhsIstrictPre ) = + (let ( !_lhsOpp) = sem _lhsInested _lhsIstrictPre + in (Syn_DataAlt _lhsOpp )) +sem_DataAlt_DataAlt :: String -> + T_Types -> + T_DataAlt +sem_DataAlt_DataAlt !name_ !(T_Types args_ ) = + (T_DataAlt (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 879 "PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (args_ _argsOnested ) of + { ( !_argsIpps) -> + (case (({-# LINE 221 "PrintCode.ag" #-} + name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens) _argsIpps) + {-# LINE 886 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_DataAlt_Record :: String -> + T_NamedTypes -> + T_DataAlt +sem_DataAlt_Record !name_ !(T_NamedTypes args_ ) = + (T_DataAlt (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 898 "PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (args_ _argsOnested ) of + { ( !_argsIpps) -> + (case (({-# LINE 222 "PrintCode.ag" #-} + name_ >#< pp_block "{" "}" "," _argsIpps + {-# LINE 905 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +-- DataAlts ---------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + strictPre : PP_Doc + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : DataAlt + child tl : DataAlts + alternative Nil: +-} +-- cata +sem_DataAlts :: DataAlts -> + T_DataAlts +sem_DataAlts !list = + (Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list) ) +-- semantic domain +newtype T_DataAlts = T_DataAlts (Bool -> + PP_Doc -> + ( PP_Docs)) +data Inh_DataAlts = Inh_DataAlts {nested_Inh_DataAlts :: !(Bool),strictPre_Inh_DataAlts :: !(PP_Doc)} +data Syn_DataAlts = Syn_DataAlts {pps_Syn_DataAlts :: !(PP_Docs)} +wrap_DataAlts :: T_DataAlts -> + Inh_DataAlts -> + Syn_DataAlts +wrap_DataAlts !(T_DataAlts sem ) !(Inh_DataAlts _lhsInested _lhsIstrictPre ) = + (let ( !_lhsOpps) = sem _lhsInested _lhsIstrictPre + in (Syn_DataAlts _lhsOpps )) +sem_DataAlts_Cons :: T_DataAlt -> + T_DataAlts -> + T_DataAlts +sem_DataAlts_Cons !(T_DataAlt hd_ ) !(T_DataAlts tl_ ) = + (T_DataAlts (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (({-# LINE 313 "PrintCode.ag" #-} + _lhsIstrictPre + {-# LINE 948 "PrintCode.hs" #-} + )) of + { !_tlOstrictPre -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 953 "PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 313 "PrintCode.ag" #-} + _lhsIstrictPre + {-# LINE 958 "PrintCode.hs" #-} + )) of + { !_hdOstrictPre -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 963 "PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested _tlOstrictPre ) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested _hdOstrictPre ) of + { ( !_hdIpp) -> + (case (({-# LINE 72 "PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 972 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) })) ) +sem_DataAlts_Nil :: T_DataAlts +sem_DataAlts_Nil = + (T_DataAlts (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (({-# LINE 73 "PrintCode.ag" #-} + [] + {-# LINE 982 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- Decl -------------------------------------------------------- +{- + visit 0: + inherited attributes: + isDeclOfLet : Bool + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Bind: + child left : Lhs + child rhs : Expr + alternative BindLet: + child left : Lhs + child rhs : Expr + alternative Comment: + child txt : {String} + alternative Data: + child name : {String} + child params : {[String]} + child alts : DataAlts + child strict : {Bool} + child derivings : {[String]} + alternative Decl: + child left : Lhs + child rhs : Expr + child binds : {Set String} + child uses : {Set String} + alternative EvalDecl: + child nt : {String} + child left : Lhs + child rhs : Expr + visit 0: + local strat : _ + alternative NewType: + child name : {String} + child params : {[String]} + child con : {String} + child tp : Type + alternative PragmaDecl: + child txt : {String} + alternative Resume: + child monadic : {Bool} + child nt : {String} + child left : Lhs + child rhs : Expr + alternative TSig: + child name : {String} + child tp : Type + alternative Type: + child name : {String} + child params : {[String]} + child tp : Type +-} +-- cata +sem_Decl :: Decl -> + T_Decl +sem_Decl !(Bind _left _rhs ) = + (sem_Decl_Bind (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Decl !(BindLet _left _rhs ) = + (sem_Decl_BindLet (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Decl !(Comment _txt ) = + (sem_Decl_Comment _txt ) +sem_Decl !(Data _name _params _alts _strict _derivings ) = + (sem_Decl_Data _name _params (sem_DataAlts _alts ) _strict _derivings ) +sem_Decl !(Decl _left _rhs _binds _uses ) = + (sem_Decl_Decl (sem_Lhs _left ) (sem_Expr _rhs ) _binds _uses ) +sem_Decl !(EvalDecl _nt _left _rhs ) = + (sem_Decl_EvalDecl _nt (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Decl !(NewType _name _params _con _tp ) = + (sem_Decl_NewType _name _params _con (sem_Type _tp ) ) +sem_Decl !(PragmaDecl _txt ) = + (sem_Decl_PragmaDecl _txt ) +sem_Decl !(Resume _monadic _nt _left _rhs ) = + (sem_Decl_Resume _monadic _nt (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Decl !(TSig _name _tp ) = + (sem_Decl_TSig _name (sem_Type _tp ) ) +sem_Decl !(Type _name _params _tp ) = + (sem_Decl_Type _name _params (sem_Type _tp ) ) +-- semantic domain +newtype T_Decl = T_Decl (Bool -> + Bool -> + Options -> + String -> + ( PP_Doc)) +data Inh_Decl = Inh_Decl {isDeclOfLet_Inh_Decl :: !(Bool),nested_Inh_Decl :: !(Bool),options_Inh_Decl :: !(Options),outputfile_Inh_Decl :: !(String)} +data Syn_Decl = Syn_Decl {pp_Syn_Decl :: !(PP_Doc)} +wrap_Decl :: T_Decl -> + Inh_Decl -> + Syn_Decl +wrap_Decl !(T_Decl sem ) !(Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile ) = + (let ( !_lhsOpp) = sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_Decl _lhsOpp )) +sem_Decl_Bind :: T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_Bind !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1091 "PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1096 "PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1101 "PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1106 "PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1111 "PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1116 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1121 "PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of + { ( !_leftIpp) -> + (case (({-# LINE 108 "PrintCode.ag" #-} + _leftIpp >#< "<-" >#< _rhsIpp + {-# LINE 1130 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) ) +sem_Decl_BindLet :: T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_BindLet !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1144 "PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1149 "PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1154 "PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1159 "PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1164 "PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1169 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1174 "PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of + { ( !_leftIpp) -> + (case (({-# LINE 109 "PrintCode.ag" #-} + "let" >#< _leftIpp >#< "=" >#< _rhsIpp + {-# LINE 1183 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) ) +sem_Decl_Comment :: String -> + T_Decl +sem_Decl_Comment !txt_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 122 "PrintCode.ag" #-} + if '\n' `elem` txt_ + then "{-" >-< vlist (lines txt_) >-< "-}" + else "--" >#< txt_ + {-# LINE 1198 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Decl_Data :: String -> + ([String]) -> + T_DataAlts -> + Bool -> + ([String]) -> + T_Decl +sem_Decl_Data !name_ !params_ !(T_DataAlts alts_ ) !strict_ !derivings_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1215 "PrintCode.hs" #-} + )) of + { !_altsOnested -> + (case (({-# LINE 316 "PrintCode.ag" #-} + if strict_ then pp "!" else empty + {-# LINE 1220 "PrintCode.hs" #-} + )) of + { !_altsOstrictPre -> + (case (alts_ _altsOnested _altsOstrictPre ) of + { ( !_altsIpps) -> + (case (({-# LINE 110 "PrintCode.ag" #-} + "data" >#< hv_sp (name_ : params_) + >#< ( case _altsIpps of + [] -> empty + (x:xs) -> "=" >#< x + >-< vlist (map ("|" >#<) xs) + >-< if null derivings_ + then empty + else "deriving" >#< ppTuple False (map text derivings_) + ) + {-# LINE 1235 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) })) ) +sem_Decl_Decl :: T_Lhs -> + T_Expr -> + (Set String) -> + (Set String) -> + T_Decl +sem_Decl_Decl !(T_Lhs left_ ) !(T_Expr rhs_ ) !binds_ !uses_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1251 "PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1256 "PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1261 "PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1266 "PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1271 "PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1276 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1281 "PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of + { ( !_leftIpp) -> + (case (({-# LINE 106 "PrintCode.ag" #-} + _leftIpp >#< "=" + >-< indent 4 _rhsIpp + {-# LINE 1291 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) ) +sem_Decl_EvalDecl :: String -> + T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_EvalDecl !nt_ !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1306 "PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1311 "PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1316 "PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1321 "PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1326 "PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1331 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1336 "PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (({-# LINE 129 "PrintCode.ag" #-} + if breadthFirstStrict _lhsIoptions + then "stepwiseEval" + else "lazyEval" + {-# LINE 1343 "PrintCode.hs" #-} + )) of + { !_strat -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of + { ( !_leftIpp) -> + (case (({-# LINE 132 "PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then _leftIpp >#< "=" >#< "case" >#< _strat >#< pp_parens _rhsIpp >#< "of" + >-< indent 4 ( + pp_parens (nt_ >|< "_Syn" >#< "_val") >#< "-> _val" + ) + else _leftIpp >#< "=" >#< _rhsIpp + {-# LINE 1357 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Decl_NewType :: String -> + ([String]) -> + String -> + T_Type -> + T_Decl +sem_Decl_NewType !name_ !params_ !con_ !(T_Type tp_ ) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1373 "PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested ) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 119 "PrintCode.ag" #-} + "newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp + {-# LINE 1380 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Decl_PragmaDecl :: String -> + T_Decl +sem_Decl_PragmaDecl !txt_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 125 "PrintCode.ag" #-} + "{-#" >#< text txt_ >#< "#-}" + {-# LINE 1393 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Decl_Resume :: Bool -> + String -> + T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_Resume !monadic_ !nt_ !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1409 "PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1414 "PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1419 "PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1424 "PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1429 "PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1434 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1439 "PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of + { ( !_leftIpp) -> + (case (({-# LINE 126 "PrintCode.ag" #-} + if monadic_ + then _leftIpp >#< "<-" >#< _rhsIpp + else _leftIpp >#< "=" >-< indent 4 _rhsIpp + {-# LINE 1450 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) ) +sem_Decl_TSig :: String -> + T_Type -> + T_Decl +sem_Decl_TSig !name_ !(T_Type tp_ ) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1464 "PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested ) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 121 "PrintCode.ag" #-} + name_ >#< "::" >#< _tpIpp + {-# LINE 1471 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Decl_Type :: String -> + ([String]) -> + T_Type -> + T_Decl +sem_Decl_Type !name_ !params_ !(T_Type tp_ ) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1486 "PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested ) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 120 "PrintCode.ag" #-} + "type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp + {-# LINE 1493 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +-- Decls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isDeclOfLet : Bool + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Decl + child tl : Decls + alternative Nil: +-} +-- cata +sem_Decls :: Decls -> + T_Decls +sem_Decls !list = + (Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list) ) +-- semantic domain +newtype T_Decls = T_Decls (Bool -> + Bool -> + Options -> + String -> + ( PP_Docs)) +data Inh_Decls = Inh_Decls {isDeclOfLet_Inh_Decls :: !(Bool),nested_Inh_Decls :: !(Bool),options_Inh_Decls :: !(Options),outputfile_Inh_Decls :: !(String)} +data Syn_Decls = Syn_Decls {pps_Syn_Decls :: !(PP_Docs)} +wrap_Decls :: T_Decls -> + Inh_Decls -> + Syn_Decls +wrap_Decls !(T_Decls sem ) !(Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile ) = + (let ( !_lhsOpps) = sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_Decls _lhsOpps )) +sem_Decls_Cons :: T_Decl -> + T_Decls -> + T_Decls +sem_Decls_Cons !(T_Decl hd_ ) !(T_Decls tl_ ) = + (T_Decls (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1542 "PrintCode.hs" #-} + )) of + { !_tlOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1547 "PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1552 "PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1557 "PrintCode.hs" #-} + )) of + { !_tlOisDeclOfLet -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1562 "PrintCode.hs" #-} + )) of + { !_hdOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1567 "PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1572 "PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1577 "PrintCode.hs" #-} + )) of + { !_hdOisDeclOfLet -> + (case (tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile ) of + { ( !_tlIpps) -> + (case (hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile ) of + { ( !_hdIpp) -> + (case (({-# LINE 84 "PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 1586 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Decls_Nil :: T_Decls +sem_Decls_Nil = + (T_Decls (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 85 "PrintCode.ag" #-} + [] + {-# LINE 1598 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- Expr -------------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative App: + child name : {String} + child args : Exprs + alternative Case: + child expr : Expr + child alts : CaseAlts + alternative Do: + child stmts : Decls + child body : Expr + alternative InvokeExpr: + child nt : {String} + child expr : Expr + child args : Exprs + alternative Lambda: + child args : Exprs + child body : Expr + visit 0: + local addBang : _ + local strictParams : _ + alternative Let: + child decls : Decls + child body : Expr + alternative LineExpr: + child expr : Expr + alternative PragmaExpr: + child onLeftSide : {Bool} + child onNewLine : {Bool} + child txt : {String} + child expr : Expr + alternative ResultExpr: + child nt : {String} + child expr : Expr + alternative ResumeExpr: + child nt : {String} + child expr : Expr + child left : Lhs + child rhs : Expr + alternative SemFun: + child nt : {String} + child args : Exprs + child body : Expr + visit 0: + local addBang : _ + local strictParams : _ + alternative SimpleExpr: + child txt : {String} + alternative TextExpr: + child lns : {[String]} + alternative Trace: + child txt : {String} + child expr : Expr + alternative TupleExpr: + child exprs : Exprs + alternative TypedExpr: + child expr : Expr + child tp : Type + alternative UnboxedTupleExpr: + child exprs : Exprs +-} +-- cata +sem_Expr :: Expr -> + T_Expr +sem_Expr !(App _name _args ) = + (sem_Expr_App _name (sem_Exprs _args ) ) +sem_Expr !(Case _expr _alts ) = + (sem_Expr_Case (sem_Expr _expr ) (sem_CaseAlts _alts ) ) +sem_Expr !(Do _stmts _body ) = + (sem_Expr_Do (sem_Decls _stmts ) (sem_Expr _body ) ) +sem_Expr !(InvokeExpr _nt _expr _args ) = + (sem_Expr_InvokeExpr _nt (sem_Expr _expr ) (sem_Exprs _args ) ) +sem_Expr !(Lambda _args _body ) = + (sem_Expr_Lambda (sem_Exprs _args ) (sem_Expr _body ) ) +sem_Expr !(Let _decls _body ) = + (sem_Expr_Let (sem_Decls _decls ) (sem_Expr _body ) ) +sem_Expr !(LineExpr _expr ) = + (sem_Expr_LineExpr (sem_Expr _expr ) ) +sem_Expr !(PragmaExpr _onLeftSide _onNewLine _txt _expr ) = + (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr ) ) +sem_Expr !(ResultExpr _nt _expr ) = + (sem_Expr_ResultExpr _nt (sem_Expr _expr ) ) +sem_Expr !(ResumeExpr _nt _expr _left _rhs ) = + (sem_Expr_ResumeExpr _nt (sem_Expr _expr ) (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Expr !(SemFun _nt _args _body ) = + (sem_Expr_SemFun _nt (sem_Exprs _args ) (sem_Expr _body ) ) +sem_Expr !(SimpleExpr _txt ) = + (sem_Expr_SimpleExpr _txt ) +sem_Expr !(TextExpr _lns ) = + (sem_Expr_TextExpr _lns ) +sem_Expr !(Trace _txt _expr ) = + (sem_Expr_Trace _txt (sem_Expr _expr ) ) +sem_Expr !(TupleExpr _exprs ) = + (sem_Expr_TupleExpr (sem_Exprs _exprs ) ) +sem_Expr !(TypedExpr _expr _tp ) = + (sem_Expr_TypedExpr (sem_Expr _expr ) (sem_Type _tp ) ) +sem_Expr !(UnboxedTupleExpr _exprs ) = + (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs ) ) +-- semantic domain +newtype T_Expr = T_Expr (Bool -> + Options -> + String -> + ( PP_Doc)) +data Inh_Expr = Inh_Expr {nested_Inh_Expr :: !(Bool),options_Inh_Expr :: !(Options),outputfile_Inh_Expr :: !(String)} +data Syn_Expr = Syn_Expr {pp_Syn_Expr :: !(PP_Doc)} +wrap_Expr :: T_Expr -> + Inh_Expr -> + Syn_Expr +wrap_Expr !(T_Expr sem ) !(Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile ) = + (let ( !_lhsOpp) = sem _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_Expr _lhsOpp )) +sem_Expr_App :: String -> + T_Exprs -> + T_Expr +sem_Expr_App !name_ !(T_Exprs args_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1730 "PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1735 "PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1740 "PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of + { ( !_argsIpps) -> + (case (({-# LINE 160 "PrintCode.ag" #-} + pp_parens $ name_ >#< hv_sp _argsIpps + {-# LINE 1747 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Expr_Case :: T_Expr -> + T_CaseAlts -> + T_Expr +sem_Expr_Case !(T_Expr expr_ ) !(T_CaseAlts alts_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1760 "PrintCode.hs" #-} + )) of + { !_altsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1765 "PrintCode.hs" #-} + )) of + { !_altsOoptions -> + (case (({-# LINE 55 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1770 "PrintCode.hs" #-} + )) of + { !_altsOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1775 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1780 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1785 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (alts_ _altsOnested _altsOoptions _altsOoutputfile ) of + { ( !_altsIpps) -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (({-# LINE 143 "PrintCode.ag" #-} + pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" + >-< (vlist _altsIpps) + ) + {-# LINE 1796 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) })) ) +sem_Expr_Do :: T_Decls -> + T_Expr -> + T_Expr +sem_Expr_Do !(T_Decls stmts_ ) !(T_Expr body_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1809 "PrintCode.hs" #-} + )) of + { !_bodyOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1814 "PrintCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1819 "PrintCode.hs" #-} + )) of + { !_bodyOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1824 "PrintCode.hs" #-} + )) of + { !_stmtsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1829 "PrintCode.hs" #-} + )) of + { !_stmtsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1834 "PrintCode.hs" #-} + )) of + { !_stmtsOnested -> + (case (({-# LINE 412 "PrintCode.ag" #-} + False + {-# LINE 1839 "PrintCode.hs" #-} + )) of + { !_stmtsOisDeclOfLet -> + (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile ) of + { ( !_bodyIpp) -> + (case (stmts_ _stmtsOisDeclOfLet _stmtsOnested _stmtsOoptions _stmtsOoutputfile ) of + { ( !_stmtsIpps) -> + (case (({-# LINE 146 "PrintCode.ag" #-} + pp_parens ( "do" >#< ( vlist _stmtsIpps + >-< ("return" >#< _bodyIpp)) + ) + {-# LINE 1850 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) ) +sem_Expr_InvokeExpr :: String -> + T_Expr -> + T_Exprs -> + T_Expr +sem_Expr_InvokeExpr !nt_ !(T_Expr expr_ ) !(T_Exprs args_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1864 "PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1869 "PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1874 "PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1879 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1884 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1889 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of + { ( !_argsIpps) -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (({-# LINE 184 "PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then "invoke" >#< pp_parens _exprIpp >#< pp_parens ( + nt_ >|< "_Inh" >#< pp_parens (ppTuple False _argsIpps)) + else _exprIpp >#< hv_sp _argsIpps + {-# LINE 1901 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) })) ) +sem_Expr_Lambda :: T_Exprs -> + T_Expr -> + T_Expr +sem_Expr_Lambda !(T_Exprs args_ ) !(T_Expr body_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1914 "PrintCode.hs" #-} + )) of + { !_bodyOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1919 "PrintCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1924 "PrintCode.hs" #-} + )) of + { !_bodyOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1929 "PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1934 "PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1939 "PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 152 "PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> pp_parens ("!" >|< p) + else id + {-# LINE 1946 "PrintCode.hs" #-} + )) of + { !_addBang -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of + { ( !_argsIpps) -> + (case (({-# LINE 149 "PrintCode.ag" #-} + if strictSems _lhsIoptions + then _argsIpps + else [] + {-# LINE 1955 "PrintCode.hs" #-} + )) of + { !_strictParams -> + (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile ) of + { ( !_bodyIpp) -> + (case (({-# LINE 155 "PrintCode.ag" #-} + pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" + >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) + ) + {-# LINE 1964 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Expr_Let :: T_Decls -> + T_Expr -> + T_Expr +sem_Expr_Let !(T_Decls decls_ ) !(T_Expr body_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1977 "PrintCode.hs" #-} + )) of + { !_bodyOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1982 "PrintCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 1987 "PrintCode.hs" #-} + )) of + { !_bodyOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1992 "PrintCode.hs" #-} + )) of + { !_declsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1997 "PrintCode.hs" #-} + )) of + { !_declsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2002 "PrintCode.hs" #-} + )) of + { !_declsOnested -> + (case (({-# LINE 410 "PrintCode.ag" #-} + True + {-# LINE 2007 "PrintCode.hs" #-} + )) of + { !_declsOisDeclOfLet -> + (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile ) of + { ( !_bodyIpp) -> + (case (decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile ) of + { ( !_declsIpps) -> + (case (({-# LINE 140 "PrintCode.ag" #-} + pp_parens ( "let" >#< (vlist _declsIpps) + >-< "in " >#< _bodyIpp + ) + {-# LINE 2018 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) ) +sem_Expr_LineExpr :: T_Expr -> + T_Expr +sem_Expr_LineExpr !(T_Expr expr_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2030 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2035 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2040 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (({-# LINE 177 "PrintCode.ag" #-} + _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}" + >-< "" + {-# LINE 2048 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Expr_PragmaExpr :: Bool -> + Bool -> + String -> + T_Expr -> + T_Expr +sem_Expr_PragmaExpr !onLeftSide_ !onNewLine_ !txt_ !(T_Expr expr_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2063 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2068 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2073 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (({-# LINE 166 "PrintCode.ag" #-} + let pragmaDoc = "{-#" >#< txt_ >#< "#-}" + op = if onNewLine_ + then (>-<) + else (>#<) + leftOp x y = if onLeftSide_ + then x `op` y + else y + rightOp x y = if onLeftSide_ + then x + else x `op` y + in pp_parens (pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc) + {-# LINE 2090 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Expr_ResultExpr :: String -> + T_Expr -> + T_Expr +sem_Expr_ResultExpr !nt_ !(T_Expr expr_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2103 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2108 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2113 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (({-# LINE 180 "PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then "final" >#< + pp_parens (nt_ >|< "_Syn" >#< pp_parens _exprIpp) + else _exprIpp + {-# LINE 2123 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Expr_ResumeExpr :: String -> + T_Expr -> + T_Lhs -> + T_Expr -> + T_Expr +sem_Expr_ResumeExpr !nt_ !(T_Expr expr_ ) !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2138 "PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2143 "PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2148 "PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2153 "PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2158 "PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2163 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2168 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2173 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2178 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (({-# LINE 414 "PrintCode.ag" #-} + False + {-# LINE 2183 "PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of + { ( !_leftIpp) -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (({-# LINE 188 "PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then pp_parens ("resume" >#< pp_parens _exprIpp + >-< indent 2 (pp_parens ( "\\" >|< + pp_parens ("~" >|< pp_parens (nt_ >|< "_Syn" >#< "_inh_arg")) + >#< "->" + >-< indent 2 ( "let" >#< _leftIpp >#< "= _inh_arg" + >-< indent 2 ("in" >#< _rhsIpp) + )))) + else pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" + >-< ("{" >#< _leftIpp >#< "->") + >-< indent 4 (_rhsIpp >#< "}") + ) + {-# LINE 2205 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Expr_SemFun :: String -> + T_Exprs -> + T_Expr -> + T_Expr +sem_Expr_SemFun !nt_ !(T_Exprs args_ ) !(T_Expr body_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2219 "PrintCode.hs" #-} + )) of + { !_bodyOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2224 "PrintCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2229 "PrintCode.hs" #-} + )) of + { !_bodyOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2234 "PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2239 "PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2244 "PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 203 "PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> pp_parens ("!" >|< p) + else id + {-# LINE 2251 "PrintCode.hs" #-} + )) of + { !_addBang -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of + { ( !_argsIpps) -> + (case (({-# LINE 200 "PrintCode.ag" #-} + if strictSems _lhsIoptions + then _argsIpps + else [] + {-# LINE 2260 "PrintCode.hs" #-} + )) of + { !_strictParams -> + (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile ) of + { ( !_bodyIpp) -> + (case (({-# LINE 206 "PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then "Child" >#< pp_parens ( "\\" >|< + pp_parens (nt_ >|< "_Inh" >#< + ppTuple False (map _addBang _argsIpps)) >#< "->" + >-< indent 2 (_strictParams `ppMultiSeqV` _bodyIpp)) + else if null _argsIpps + then _bodyIpp + else pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" + >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) + ) + {-# LINE 2276 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Expr_SimpleExpr :: String -> + T_Expr +sem_Expr_SimpleExpr !txt_ = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 161 "PrintCode.ag" #-} + text txt_ + {-# LINE 2288 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Expr_TextExpr :: ([String]) -> + T_Expr +sem_Expr_TextExpr !lns_ = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 162 "PrintCode.ag" #-} + vlist (map text lns_) + {-# LINE 2300 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Expr_Trace :: String -> + T_Expr -> + T_Expr +sem_Expr_Trace !txt_ !(T_Expr expr_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2313 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2318 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2323 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (({-# LINE 163 "PrintCode.ag" #-} + "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") + >-< pp_parens _exprIpp + ) + {-# LINE 2332 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Expr_TupleExpr :: T_Exprs -> + T_Expr +sem_Expr_TupleExpr !(T_Exprs exprs_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2344 "PrintCode.hs" #-} + )) of + { !_exprsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2349 "PrintCode.hs" #-} + )) of + { !_exprsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2354 "PrintCode.hs" #-} + )) of + { !_exprsOnested -> + (case (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile ) of + { ( !_exprsIpps) -> + (case (({-# LINE 158 "PrintCode.ag" #-} + ppTuple _lhsInested _exprsIpps + {-# LINE 2361 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Expr_TypedExpr :: T_Expr -> + T_Type -> + T_Expr +sem_Expr_TypedExpr !(T_Expr expr_ ) !(T_Type tp_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2374 "PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2379 "PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2384 "PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2389 "PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (tp_ _tpOnested ) of + { ( !_tpIpp,!_tpIprec) -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of + { ( !_exprIpp) -> + (case (({-# LINE 179 "PrintCode.ag" #-} + pp_parens (_exprIpp >#< "::" >#< _tpIpp) + {-# LINE 2398 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) })) ) +sem_Expr_UnboxedTupleExpr :: T_Exprs -> + T_Expr +sem_Expr_UnboxedTupleExpr !(T_Exprs exprs_ ) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2410 "PrintCode.hs" #-} + )) of + { !_exprsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2415 "PrintCode.hs" #-} + )) of + { !_exprsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2420 "PrintCode.hs" #-} + )) of + { !_exprsOnested -> + (case (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile ) of + { ( !_exprsIpps) -> + (case (({-# LINE 159 "PrintCode.ag" #-} + ppUnboxedTuple _lhsInested _exprsIpps + {-# LINE 2427 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +-- Exprs ------------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Expr + child tl : Exprs + alternative Nil: +-} +-- cata +sem_Exprs :: Exprs -> + T_Exprs +sem_Exprs !list = + (Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list) ) +-- semantic domain +newtype T_Exprs = T_Exprs (Bool -> + Options -> + String -> + ( PP_Docs)) +data Inh_Exprs = Inh_Exprs {nested_Inh_Exprs :: !(Bool),options_Inh_Exprs :: !(Options),outputfile_Inh_Exprs :: !(String)} +data Syn_Exprs = Syn_Exprs {pps_Syn_Exprs :: !(PP_Docs)} +wrap_Exprs :: T_Exprs -> + Inh_Exprs -> + Syn_Exprs +wrap_Exprs !(T_Exprs sem ) !(Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile ) = + (let ( !_lhsOpps) = sem _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_Exprs _lhsOpps )) +sem_Exprs_Cons :: T_Expr -> + T_Exprs -> + T_Exprs +sem_Exprs_Cons !(T_Expr hd_ ) !(T_Exprs tl_ ) = + (T_Exprs (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2473 "PrintCode.hs" #-} + )) of + { !_tlOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2478 "PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2483 "PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2488 "PrintCode.hs" #-} + )) of + { !_hdOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2493 "PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2498 "PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested _tlOoptions _tlOoutputfile ) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested _hdOoptions _hdOoutputfile ) of + { ( !_hdIpp) -> + (case (({-# LINE 64 "PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 2507 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) })) ) +sem_Exprs_Nil :: T_Exprs +sem_Exprs_Nil = + (T_Exprs (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 65 "PrintCode.ag" #-} + [] + {-# LINE 2518 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- Lhs --------------------------------------------------------- +{- + visit 0: + inherited attributes: + isDeclOfLet : Bool + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Fun: + child name : {String} + child args : Exprs + visit 0: + local addBang : _ + local strictGuard : _ + local hasStrictVars : _ + local addStrictGuard : _ + alternative Pattern3: + child pat3 : Pattern + visit 0: + local hasStrictVars : _ + local strictGuard : _ + local addStrictGuard : _ + alternative Pattern3SM: + child pat3 : Pattern + alternative TupleLhs: + child comps : {[String]} + visit 0: + local addBang : _ + local hasStrictVars : _ + local strictGuard : _ + local addStrictGuard : _ + alternative UnboxedTupleLhs: + child comps : {[String]} + visit 0: + local addBang : _ + local hasStrictVars : _ + local strictGuard : _ + local addStrictGuard : _ + alternative Unwrap: + child name : {String} + child sub : Lhs +-} +-- cata +sem_Lhs :: Lhs -> + T_Lhs +sem_Lhs !(Fun _name _args ) = + (sem_Lhs_Fun _name (sem_Exprs _args ) ) +sem_Lhs !(Pattern3 _pat3 ) = + (sem_Lhs_Pattern3 (sem_Pattern _pat3 ) ) +sem_Lhs !(Pattern3SM _pat3 ) = + (sem_Lhs_Pattern3SM (sem_Pattern _pat3 ) ) +sem_Lhs !(TupleLhs _comps ) = + (sem_Lhs_TupleLhs _comps ) +sem_Lhs !(UnboxedTupleLhs _comps ) = + (sem_Lhs_UnboxedTupleLhs _comps ) +sem_Lhs !(Unwrap _name _sub ) = + (sem_Lhs_Unwrap _name (sem_Lhs _sub ) ) +-- semantic domain +newtype T_Lhs = T_Lhs (Bool -> + Bool -> + Options -> + String -> + ( PP_Doc)) +data Inh_Lhs = Inh_Lhs {isDeclOfLet_Inh_Lhs :: !(Bool),nested_Inh_Lhs :: !(Bool),options_Inh_Lhs :: !(Options),outputfile_Inh_Lhs :: !(String)} +data Syn_Lhs = Syn_Lhs {pp_Syn_Lhs :: !(PP_Doc)} +wrap_Lhs :: T_Lhs -> + Inh_Lhs -> + Syn_Lhs +wrap_Lhs !(T_Lhs sem ) !(Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile ) = + (let ( !_lhsOpp) = sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_Lhs _lhsOpp )) +sem_Lhs_Fun :: String -> + T_Exprs -> + T_Lhs +sem_Lhs_Fun !name_ !(T_Exprs args_ ) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2606 "PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2611 "PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2616 "PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 247 "PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> "!" >|< p + else id + {-# LINE 2623 "PrintCode.hs" #-} + )) of + { !_addBang -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of + { ( !_argsIpps) -> + (case (({-# LINE 244 "PrintCode.ag" #-} + _argsIpps `ppMultiSeqH` (pp "True") + {-# LINE 2630 "PrintCode.hs" #-} + )) of + { !_strictGuard -> + (case (({-# LINE 243 "PrintCode.ag" #-} + not (null _argsIpps) + {-# LINE 2635 "PrintCode.hs" #-} + )) of + { !_hasStrictVars -> + (case (({-# LINE 242 "PrintCode.ag" #-} + if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id + {-# LINE 2640 "PrintCode.hs" #-} + )) of + { !_addStrictGuard -> + (case (({-# LINE 255 "PrintCode.ag" #-} + _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) + {-# LINE 2645 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) })) ) +sem_Lhs_Pattern3 :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3 !(T_Pattern pat3_ ) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2658 "PrintCode.hs" #-} + )) of + { !_pat3Ooptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 2663 "PrintCode.hs" #-} + )) of + { !_pat3OisDeclOfLet -> + (case (({-# LINE 376 "PrintCode.ag" #-} + False + {-# LINE 2668 "PrintCode.hs" #-} + )) of + { !_pat3ObelowIrrefutable -> + (case (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions ) of + { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> + (case (({-# LINE 234 "PrintCode.ag" #-} + not (null _pat3IstrictVars) + {-# LINE 2675 "PrintCode.hs" #-} + )) of + { !_hasStrictVars -> + (case (({-# LINE 233 "PrintCode.ag" #-} + _pat3IstrictVars `ppMultiSeqH` (pp "True") + {-# LINE 2680 "PrintCode.hs" #-} + )) of + { !_strictGuard -> + (case (({-# LINE 231 "PrintCode.ag" #-} + if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id + {-# LINE 2685 "PrintCode.hs" #-} + )) of + { !_addStrictGuard -> + (case (({-# LINE 251 "PrintCode.ag" #-} + _addStrictGuard _pat3Ipp + {-# LINE 2690 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) })) ) +sem_Lhs_Pattern3SM :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3SM !(T_Pattern pat3_ ) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2703 "PrintCode.hs" #-} + )) of + { !_pat3Ooptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 2708 "PrintCode.hs" #-} + )) of + { !_pat3OisDeclOfLet -> + (case (({-# LINE 376 "PrintCode.ag" #-} + False + {-# LINE 2713 "PrintCode.hs" #-} + )) of + { !_pat3ObelowIrrefutable -> + (case (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions ) of + { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> + (case (({-# LINE 252 "PrintCode.ag" #-} + _pat3Ipp' + {-# LINE 2720 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Lhs_TupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_TupleLhs !comps_ = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 247 "PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> "!" >|< p + else id + {-# LINE 2735 "PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 239 "PrintCode.ag" #-} + not (null comps_) + {-# LINE 2740 "PrintCode.hs" #-} + )) of + { !_hasStrictVars -> + (case (({-# LINE 236 "PrintCode.ag" #-} + if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then map text comps_ `ppMultiSeqH` (pp "True") + else pp "True" + {-# LINE 2747 "PrintCode.hs" #-} + )) of + { !_strictGuard -> + (case (({-# LINE 231 "PrintCode.ag" #-} + if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id + {-# LINE 2752 "PrintCode.hs" #-} + )) of + { !_addStrictGuard -> + (case (({-# LINE 253 "PrintCode.ag" #-} + _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) + {-# LINE 2757 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Lhs_UnboxedTupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_UnboxedTupleLhs !comps_ = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 247 "PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> "!" >|< p + else id + {-# LINE 2772 "PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 239 "PrintCode.ag" #-} + not (null comps_) + {-# LINE 2777 "PrintCode.hs" #-} + )) of + { !_hasStrictVars -> + (case (({-# LINE 236 "PrintCode.ag" #-} + if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then map text comps_ `ppMultiSeqH` (pp "True") + else pp "True" + {-# LINE 2784 "PrintCode.hs" #-} + )) of + { !_strictGuard -> + (case (({-# LINE 231 "PrintCode.ag" #-} + if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id + {-# LINE 2789 "PrintCode.hs" #-} + )) of + { !_addStrictGuard -> + (case (({-# LINE 254 "PrintCode.ag" #-} + _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) + {-# LINE 2794 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Lhs_Unwrap :: String -> + T_Lhs -> + T_Lhs +sem_Lhs_Unwrap !name_ !(T_Lhs sub_ ) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 39 "PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2808 "PrintCode.hs" #-} + )) of + { !_subOoutputfile -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2813 "PrintCode.hs" #-} + )) of + { !_subOoptions -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2818 "PrintCode.hs" #-} + )) of + { !_subOnested -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 2823 "PrintCode.hs" #-} + )) of + { !_subOisDeclOfLet -> + (case (sub_ _subOisDeclOfLet _subOnested _subOoptions _subOoutputfile ) of + { ( !_subIpp) -> + (case (({-# LINE 256 "PrintCode.ag" #-} + pp_parens (name_ >#< _subIpp) + {-# LINE 2830 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) })) ) +-- NamedType --------------------------------------------------- +{- + visit 0: + inherited attribute: + nested : Bool + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Named: + child strict : {Bool} + child name : {String} + child tp : Type +-} +-- cata +sem_NamedType :: NamedType -> + T_NamedType +sem_NamedType !(Named _strict _name _tp ) = + (sem_NamedType_Named _strict _name (sem_Type _tp ) ) +-- semantic domain +newtype T_NamedType = T_NamedType (Bool -> + ( PP_Doc)) +data Inh_NamedType = Inh_NamedType {nested_Inh_NamedType :: !(Bool)} +data Syn_NamedType = Syn_NamedType {pp_Syn_NamedType :: !(PP_Doc)} +wrap_NamedType :: T_NamedType -> + Inh_NamedType -> + Syn_NamedType +wrap_NamedType !(T_NamedType sem ) !(Inh_NamedType _lhsInested ) = + (let ( !_lhsOpp) = sem _lhsInested + in (Syn_NamedType _lhsOpp )) +sem_NamedType_Named :: Bool -> + String -> + T_Type -> + T_NamedType +sem_NamedType_Named !strict_ !name_ !(T_Type tp_ ) = + (T_NamedType (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2871 "PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested ) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 225 "PrintCode.ag" #-} + if strict_ + then name_ >#< "::" >#< "!" >|< pp_parens _tpIpp + else name_ >#< "::" >#< _tpIpp + {-# LINE 2880 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +-- NamedTypes -------------------------------------------------- +{- + visit 0: + inherited attribute: + nested : Bool + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : NamedType + child tl : NamedTypes + alternative Nil: +-} +-- cata +sem_NamedTypes :: NamedTypes -> + T_NamedTypes +sem_NamedTypes !list = + (Prelude.foldr sem_NamedTypes_Cons sem_NamedTypes_Nil (Prelude.map sem_NamedType list) ) +-- semantic domain +newtype T_NamedTypes = T_NamedTypes (Bool -> + ( PP_Docs)) +data Inh_NamedTypes = Inh_NamedTypes {nested_Inh_NamedTypes :: !(Bool)} +data Syn_NamedTypes = Syn_NamedTypes {pps_Syn_NamedTypes :: !(PP_Docs)} +wrap_NamedTypes :: T_NamedTypes -> + Inh_NamedTypes -> + Syn_NamedTypes +wrap_NamedTypes !(T_NamedTypes sem ) !(Inh_NamedTypes _lhsInested ) = + (let ( !_lhsOpps) = sem _lhsInested + in (Syn_NamedTypes _lhsOpps )) +sem_NamedTypes_Cons :: T_NamedType -> + T_NamedTypes -> + T_NamedTypes +sem_NamedTypes_Cons !(T_NamedType hd_ ) !(T_NamedTypes tl_ ) = + (T_NamedTypes (\ (!_lhsInested) -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2920 "PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 2925 "PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested ) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested ) of + { ( !_hdIpp) -> + (case (({-# LINE 80 "PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 2934 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) })) ) +sem_NamedTypes_Nil :: T_NamedTypes +sem_NamedTypes_Nil = + (T_NamedTypes (\ (!_lhsInested) -> + (case (({-# LINE 81 "PrintCode.ag" #-} + [] + {-# LINE 2943 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + belowIrrefutable : Bool + isDeclOfLet : Bool + options : Options + synthesized attributes: + copy : SELF + isUnderscore : Bool + pp : PP_Doc + pp' : PP_Doc + strictVars : [PP_Doc] + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + local ppVar : _ + local addBang : _ + local ppVarBang : _ + local strictPatVars : _ + local strictVar : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local addBang : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local addBang : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern !(Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern !(Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern !(Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern !(Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern !(Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (Bool -> + Bool -> + Options -> + ( Pattern ,Bool,PP_Doc,PP_Doc,([PP_Doc]))) +data Inh_Pattern = Inh_Pattern {belowIrrefutable_Inh_Pattern :: !(Bool),isDeclOfLet_Inh_Pattern :: !(Bool),options_Inh_Pattern :: !(Options)} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern ),isUnderscore_Syn_Pattern :: !(Bool),pp_Syn_Pattern :: !(PP_Doc),pp'_Syn_Pattern :: !(PP_Doc),strictVars_Syn_Pattern :: !(([PP_Doc]))} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern !(T_Pattern sem ) !(Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions ) = + (let ( !_lhsOcopy,!_lhsOisUnderscore,!_lhsOpp,!_lhsOpp',!_lhsOstrictVars) = sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions + in (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3031 "PrintCode.hs" #-} + )) of + { !_partsOoptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3036 "PrintCode.hs" #-} + )) of + { !_partsOisDeclOfLet -> + (case (({-# LINE 369 "PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3041 "PrintCode.hs" #-} + )) of + { !_partsObelowIrrefutable -> + (case (parts_ _partsObelowIrrefutable _partsOisDeclOfLet _partsOoptions ) of + { ( !_partsIcopy,!_partsIpps,!_partsIpps',!_partsIstrictVars) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3048 "PrintCode.hs" #-} + )) of + { !_patOoptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3053 "PrintCode.hs" #-} + )) of + { !_patOisDeclOfLet -> + (case (({-# LINE 369 "PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3058 "PrintCode.hs" #-} + )) of + { !_patObelowIrrefutable -> + (case (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions ) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 3065 "PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3070 "PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 366 "PrintCode.ag" #-} + False + {-# LINE 3075 "PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 355 "PrintCode.ag" #-} + pp (attrname False field_ attr_) + {-# LINE 3080 "PrintCode.hs" #-} + )) of + { !_ppVar -> + (case (({-# LINE 348 "PrintCode.ag" #-} + if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id + {-# LINE 3087 "PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 356 "PrintCode.ag" #-} + _addBang $ _ppVar + {-# LINE 3092 "PrintCode.hs" #-} + )) of + { !_ppVarBang -> + (case (({-# LINE 357 "PrintCode.ag" #-} + if _patIisUnderscore + then _ppVarBang + else _ppVarBang >|< "@" >|< _patIpp + {-# LINE 3099 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 389 "PrintCode.ag" #-} + let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ + | otherwise = attrname False field_ attr_ + in attribute >|< "@" >|< _patIpp' + {-# LINE 3106 "PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 329 "PrintCode.ag" #-} + if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then _patIstrictVars + else [] + {-# LINE 3113 "PrintCode.hs" #-} + )) of + { !_strictPatVars -> + (case (({-# LINE 325 "PrintCode.ag" #-} + if strictCases _lhsIoptions && not _lhsIisDeclOfLet + then [_ppVar ] + else [] + {-# LINE 3120 "PrintCode.hs" #-} + )) of + { !_strictVar -> + (case (({-# LINE 333 "PrintCode.ag" #-} + _strictVar ++ _strictPatVars + {-# LINE 3125 "PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_ ) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3138 "PrintCode.hs" #-} + )) of + { !_patsOoptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3143 "PrintCode.hs" #-} + )) of + { !_patsOisDeclOfLet -> + (case (({-# LINE 369 "PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3148 "PrintCode.hs" #-} + )) of + { !_patsObelowIrrefutable -> + (case (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions ) of + { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 3155 "PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3160 "PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 364 "PrintCode.ag" #-} + False + {-# LINE 3165 "PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 348 "PrintCode.ag" #-} + if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id + {-# LINE 3172 "PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 353 "PrintCode.ag" #-} + _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps + {-# LINE 3177 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 387 "PrintCode.ag" #-} + pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') + {-# LINE 3182 "PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 322 "PrintCode.ag" #-} + _patsIstrictVars + {-# LINE 3187 "PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_ ) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3199 "PrintCode.hs" #-} + )) of + { !_patOoptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3204 "PrintCode.hs" #-} + )) of + { !_patOisDeclOfLet -> + (case (({-# LINE 372 "PrintCode.ag" #-} + True + {-# LINE 3209 "PrintCode.hs" #-} + )) of + { !_patObelowIrrefutable -> + (case (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions ) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 3216 "PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3221 "PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 363 "PrintCode.ag" #-} + _patIisUnderscore + {-# LINE 3226 "PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 360 "PrintCode.ag" #-} + text "~" >|< pp_parens _patIpp + {-# LINE 3231 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 392 "PrintCode.ag" #-} + text "~" >|< pp_parens _patIpp + {-# LINE 3236 "PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 336 "PrintCode.ag" #-} + [] + {-# LINE 3241 "PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_ ) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3254 "PrintCode.hs" #-} + )) of + { !_patsOoptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3259 "PrintCode.hs" #-} + )) of + { !_patsOisDeclOfLet -> + (case (({-# LINE 369 "PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3264 "PrintCode.hs" #-} + )) of + { !_patsObelowIrrefutable -> + (case (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions ) of + { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 3271 "PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3276 "PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 365 "PrintCode.ag" #-} + False + {-# LINE 3281 "PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 348 "PrintCode.ag" #-} + if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id + {-# LINE 3288 "PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 354 "PrintCode.ag" #-} + _addBang $ pp_block "(" ")" "," _patsIpps + {-# LINE 3293 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 388 "PrintCode.ag" #-} + pp_block "(" ")" "," _patsIpps' + {-# LINE 3298 "PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 322 "PrintCode.ag" #-} + _patsIstrictVars + {-# LINE 3303 "PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 3315 "PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3320 "PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 367 "PrintCode.ag" #-} + True + {-# LINE 3325 "PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 361 "PrintCode.ag" #-} + text "_" + {-# LINE 3330 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 393 "PrintCode.ag" #-} + text "_" + {-# LINE 3335 "PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 322 "PrintCode.ag" #-} + [] + {-# LINE 3340 "PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) })) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + belowIrrefutable : Bool + isDeclOfLet : Bool + options : Options + synthesized attributes: + copy : SELF + pps : [PP_Doc] + pps' : [PP_Doc] + strictVars : [PP_Doc] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (Bool -> + Bool -> + Options -> + ( Patterns ,([PP_Doc]),([PP_Doc]),([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {belowIrrefutable_Inh_Patterns :: !(Bool),isDeclOfLet_Inh_Patterns :: !(Bool),options_Inh_Patterns :: !(Options)} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns ),pps_Syn_Patterns :: !(([PP_Doc])),pps'_Syn_Patterns :: !(([PP_Doc])),strictVars_Syn_Patterns :: !(([PP_Doc]))} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns !(T_Patterns sem ) !(Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions ) = + (let ( !_lhsOcopy,!_lhsOpps,!_lhsOpps',!_lhsOstrictVars) = sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions + in (Syn_Patterns _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons !(T_Pattern hd_ ) !(T_Patterns tl_ ) = + (T_Patterns (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3393 "PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3398 "PrintCode.hs" #-} + )) of + { !_tlOisDeclOfLet -> + (case (({-# LINE 369 "PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3403 "PrintCode.hs" #-} + )) of + { !_tlObelowIrrefutable -> + (case (tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions ) of + { ( !_tlIcopy,!_tlIpps,!_tlIpps',!_tlIstrictVars) -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3410 "PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 403 "PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3415 "PrintCode.hs" #-} + )) of + { !_hdOisDeclOfLet -> + (case (({-# LINE 369 "PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3420 "PrintCode.hs" #-} + )) of + { !_hdObelowIrrefutable -> + (case (hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions ) of + { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp,!_hdIpp',!_hdIstrictVars) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 3427 "PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3432 "PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 343 "PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 3437 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + (case (({-# LINE 383 "PrintCode.ag" #-} + _hdIpp' : _tlIpps' + {-# LINE 3442 "PrintCode.hs" #-} + )) of + { !_lhsOpps' -> + (case (({-# LINE 322 "PrintCode.ag" #-} + _hdIstrictVars ++ _tlIstrictVars + {-# LINE 3447 "PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 3458 "PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 3463 "PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 344 "PrintCode.ag" #-} + [] + {-# LINE 3468 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + (case (({-# LINE 384 "PrintCode.ag" #-} + [] + {-# LINE 3473 "PrintCode.hs" #-} + )) of + { !_lhsOpps' -> + (case (({-# LINE 322 "PrintCode.ag" #-} + [] + {-# LINE 3478 "PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) })) ) +-- Program ----------------------------------------------------- +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + options : Options + optionsLine : String + pragmaBlocks : String + textBlockMap : Map BlockInfo PP_Doc + textBlocks : PP_Doc + synthesized attributes: + genIO : IO () + output : PP_Docs + alternatives: + alternative Program: + child chunks : Chunks + child ordered : {Bool} + visit 0: + local options : _ + local commonFile : _ + local genCommonModule : _ + local mainModuleFile : _ + local genMainModule : _ +-} +-- cata +sem_Program :: Program -> + T_Program +sem_Program !(Program _chunks _ordered ) = + (sem_Program_Program (sem_Chunks _chunks ) _ordered ) +-- semantic domain +newtype T_Program = T_Program (PP_Doc -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Options -> + String -> + String -> + (Map BlockInfo PP_Doc) -> + PP_Doc -> + ( (IO ()),PP_Docs)) +data Inh_Program = Inh_Program {importBlocks_Inh_Program :: !(PP_Doc),mainFile_Inh_Program :: !(String),mainName_Inh_Program :: !(String),moduleHeader_Inh_Program :: !((String -> String -> String -> Bool -> String)),options_Inh_Program :: !(Options),optionsLine_Inh_Program :: !(String),pragmaBlocks_Inh_Program :: !(String),textBlockMap_Inh_Program :: !((Map BlockInfo PP_Doc)),textBlocks_Inh_Program :: !(PP_Doc)} +data Syn_Program = Syn_Program {genIO_Syn_Program :: !((IO ())),output_Syn_Program :: !(PP_Docs)} +wrap_Program :: T_Program -> + Inh_Program -> + Syn_Program +wrap_Program !(T_Program sem ) !(Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) = + (let ( !_lhsOgenIO,!_lhsOoutput) = sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks + in (Syn_Program _lhsOgenIO _lhsOoutput )) +sem_Program_Program :: T_Chunks -> + Bool -> + T_Program +sem_Program_Program !(T_Chunks chunks_ ) !ordered_ = + (T_Program (\ (!_lhsIimportBlocks) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case (({-# LINE 431 "PrintCode.ag" #-} + _lhsItextBlockMap + {-# LINE 3548 "PrintCode.hs" #-} + )) of + { !_chunksOtextBlockMap -> + (case (({-# LINE 429 "PrintCode.ag" #-} + _lhsIpragmaBlocks + {-# LINE 3553 "PrintCode.hs" #-} + )) of + { !_chunksOpragmaBlocks -> + (case (({-# LINE 432 "PrintCode.ag" #-} + _lhsIoptionsLine + {-# LINE 3558 "PrintCode.hs" #-} + )) of + { !_chunksOoptionsLine -> + (case (({-# LINE 58 "PrintCode.ag" #-} + _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && ordered_ } + {-# LINE 3563 "PrintCode.hs" #-} + )) of + { !_options -> + (case (({-# LINE 49 "PrintCode.ag" #-} + _options + {-# LINE 3568 "PrintCode.hs" #-} + )) of + { !_chunksOoptions -> + (case (({-# LINE 435 "PrintCode.ag" #-} + _lhsImoduleHeader + {-# LINE 3573 "PrintCode.hs" #-} + )) of + { !_chunksOmoduleHeader -> + (case (({-# LINE 434 "PrintCode.ag" #-} + _lhsImainName + {-# LINE 3578 "PrintCode.hs" #-} + )) of + { !_chunksOmainName -> + (case (({-# LINE 433 "PrintCode.ag" #-} + _lhsImainFile + {-# LINE 3583 "PrintCode.hs" #-} + )) of + { !_chunksOmainFile -> + (case (({-# LINE 452 "PrintCode.ag" #-} + _lhsImainFile ++ "_common.hs" + {-# LINE 3588 "PrintCode.hs" #-} + )) of + { !_commonFile -> + (case (({-# LINE 406 "PrintCode.ag" #-} + False + {-# LINE 3593 "PrintCode.hs" #-} + )) of + { !_chunksOisDeclOfLet -> + (case (({-# LINE 61 "PrintCode.ag" #-} + nest _lhsIoptions + {-# LINE 3598 "PrintCode.hs" #-} + )) of + { !_chunksOnested -> + (case (({-# LINE 430 "PrintCode.ag" #-} + _lhsItextBlocks + {-# LINE 3603 "PrintCode.hs" #-} + )) of + { !_chunksOtextBlocks -> + (case (({-# LINE 428 "PrintCode.ag" #-} + _lhsIimportBlocks + {-# LINE 3608 "PrintCode.hs" #-} + )) of + { !_chunksOimportBlocks -> + (case (chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlockMap _chunksOtextBlocks ) of + { ( !_chunksIappendCommon,!_chunksIappendMain,!_chunksIgenSems,!_chunksIimports,!_chunksIpps) -> + (case (({-# LINE 453 "PrintCode.ag" #-} + writeModule _commonFile + ( [ pp $ _lhsIpragmaBlocks + , pp $ _lhsIoptionsLine + , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True + , _lhsIimportBlocks + , _lhsItextBlocks + ] + ++ map vlist _chunksIappendCommon + ) + {-# LINE 3623 "PrintCode.hs" #-} + )) of + { !_genCommonModule -> + (case (({-# LINE 440 "PrintCode.ag" #-} + _lhsImainFile ++ ".hs" + {-# LINE 3628 "PrintCode.hs" #-} + )) of + { !_mainModuleFile -> + (case (({-# LINE 441 "PrintCode.ag" #-} + writeModule _mainModuleFile + ( [ pp $ _lhsIpragmaBlocks + , pp $ _lhsIoptionsLine + , pp $ _lhsImoduleHeader _lhsImainName "" "" False + , pp $ ("import " ++ _lhsImainName ++ "_common\n") + ] + ++ map pp _chunksIimports + ++ map vlist _chunksIappendMain + ) + {-# LINE 3641 "PrintCode.hs" #-} + )) of + { !_genMainModule -> + (case (({-# LINE 464 "PrintCode.ag" #-} + do _genMainModule + _genCommonModule + _chunksIgenSems + {-# LINE 3648 "PrintCode.hs" #-} + )) of + { !_lhsOgenIO -> + (case (({-# LINE 93 "PrintCode.ag" #-} + _chunksIpps + {-# LINE 3653 "PrintCode.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOgenIO,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Type -------------------------------------------------------- +{- + visit 0: + inherited attribute: + nested : Bool + synthesized attributes: + pp : PP_Doc + prec : Int + alternatives: + alternative Arr: + child left : Type + child right : Type + visit 0: + local r : _ + local l : _ + alternative CtxApp: + child left : {[(String, [String])]} + child right : Type + alternative List: + child tp : Type + alternative NontermType: + child name : {String} + child params : {[String]} + alternative QuantApp: + child left : {String} + child right : Type + alternative SimpleType: + child txt : {String} + alternative TEither: + child left : Type + child right : Type + alternative TIntMap: + child value : Type + alternative TMap: + child key : Type + child value : Type + alternative TMaybe: + child tp : Type + alternative TupleType: + child tps : Types + alternative TypeApp: + child func : Type + child args : Types + alternative UnboxedTupleType: + child tps : Types +-} +-- cata +sem_Type :: Type -> + T_Type +sem_Type !(Arr _left _right ) = + (sem_Type_Arr (sem_Type _left ) (sem_Type _right ) ) +sem_Type !(CtxApp _left _right ) = + (sem_Type_CtxApp _left (sem_Type _right ) ) +sem_Type !(List _tp ) = + (sem_Type_List (sem_Type _tp ) ) +sem_Type !(NontermType _name _params ) = + (sem_Type_NontermType _name _params ) +sem_Type !(QuantApp _left _right ) = + (sem_Type_QuantApp _left (sem_Type _right ) ) +sem_Type !(SimpleType _txt ) = + (sem_Type_SimpleType _txt ) +sem_Type !(TEither _left _right ) = + (sem_Type_TEither (sem_Type _left ) (sem_Type _right ) ) +sem_Type !(TIntMap _value ) = + (sem_Type_TIntMap (sem_Type _value ) ) +sem_Type !(TMap _key _value ) = + (sem_Type_TMap (sem_Type _key ) (sem_Type _value ) ) +sem_Type !(TMaybe _tp ) = + (sem_Type_TMaybe (sem_Type _tp ) ) +sem_Type !(TupleType _tps ) = + (sem_Type_TupleType (sem_Types _tps ) ) +sem_Type !(TypeApp _func _args ) = + (sem_Type_TypeApp (sem_Type _func ) (sem_Types _args ) ) +sem_Type !(UnboxedTupleType _tps ) = + (sem_Type_UnboxedTupleType (sem_Types _tps ) ) +-- semantic domain +newtype T_Type = T_Type (Bool -> + ( PP_Doc,Int)) +data Inh_Type = Inh_Type {nested_Inh_Type :: !(Bool)} +data Syn_Type = Syn_Type {pp_Syn_Type :: !(PP_Doc),prec_Syn_Type :: !(Int)} +wrap_Type :: T_Type -> + Inh_Type -> + Syn_Type +wrap_Type !(T_Type sem ) !(Inh_Type _lhsInested ) = + (let ( !_lhsOpp,!_lhsOprec) = sem _lhsInested + in (Syn_Type _lhsOpp _lhsOprec )) +sem_Type_Arr :: T_Type -> + T_Type -> + T_Type +sem_Type_Arr !(T_Type left_ ) !(T_Type right_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3750 "PrintCode.hs" #-} + )) of + { !_rightOnested -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3755 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (right_ _rightOnested ) of + { ( !_rightIpp,!_rightIprec) -> + (case (({-# LINE 262 "PrintCode.ag" #-} + if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp + {-# LINE 3762 "PrintCode.hs" #-} + )) of + { !_r -> + (case (left_ _leftOnested ) of + { ( !_leftIpp,!_leftIprec) -> + (case (({-# LINE 261 "PrintCode.ag" #-} + if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp + {-# LINE 3769 "PrintCode.hs" #-} + )) of + { !_l -> + (case (({-# LINE 260 "PrintCode.ag" #-} + _l >#< "->" >-< _r + {-# LINE 3774 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 259 "PrintCode.ag" #-} + 2 + {-# LINE 3779 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) }) }) })) ) +sem_Type_CtxApp :: ([(String, [String])]) -> + T_Type -> + T_Type +sem_Type_CtxApp !left_ !(T_Type right_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3790 "PrintCode.hs" #-} + )) of + { !_rightOnested -> + (case (right_ _rightOnested ) of + { ( !_rightIpp,!_rightIprec) -> + (case (({-# LINE 268 "PrintCode.ag" #-} + (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp + {-# LINE 3797 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 258 "PrintCode.ag" #-} + _rightIprec + {-# LINE 3802 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) })) ) +sem_Type_List :: T_Type -> + T_Type +sem_Type_List !(T_Type tp_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3812 "PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested ) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 279 "PrintCode.ag" #-} + "[" >|< _tpIpp >|< "]" + {-# LINE 3819 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 278 "PrintCode.ag" #-} + 5 + {-# LINE 3824 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) })) ) +sem_Type_NontermType :: String -> + ([String]) -> + T_Type +sem_Type_NontermType !name_ !params_ = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 285 "PrintCode.ag" #-} + text name_ >#< hv_sp params_ + {-# LINE 3835 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 284 "PrintCode.ag" #-} + 5 + {-# LINE 3840 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) })) ) +sem_Type_QuantApp :: String -> + T_Type -> + T_Type +sem_Type_QuantApp !left_ !(T_Type right_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3851 "PrintCode.hs" #-} + )) of + { !_rightOnested -> + (case (right_ _rightOnested ) of + { ( !_rightIpp,!_rightIprec) -> + (case (({-# LINE 270 "PrintCode.ag" #-} + left_ >#< _rightIpp + {-# LINE 3858 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 258 "PrintCode.ag" #-} + _rightIprec + {-# LINE 3863 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) })) ) +sem_Type_SimpleType :: String -> + T_Type +sem_Type_SimpleType !txt_ = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 282 "PrintCode.ag" #-} + if reallySimple txt_ then text txt_ else pp_parens (text txt_) + {-# LINE 3873 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 281 "PrintCode.ag" #-} + 5 + {-# LINE 3878 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) })) ) +sem_Type_TEither :: T_Type -> + T_Type -> + T_Type +sem_Type_TEither !(T_Type left_ ) !(T_Type right_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3889 "PrintCode.hs" #-} + )) of + { !_rightOnested -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3894 "PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (right_ _rightOnested ) of + { ( !_rightIpp,!_rightIprec) -> + (case (left_ _leftOnested ) of + { ( !_leftIpp,!_leftIprec) -> + (case (({-# LINE 289 "PrintCode.ag" #-} + text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp + {-# LINE 3903 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 288 "PrintCode.ag" #-} + 5 + {-# LINE 3908 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) })) ) +sem_Type_TIntMap :: T_Type -> + T_Type +sem_Type_TIntMap !(T_Type value_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3918 "PrintCode.hs" #-} + )) of + { !_valueOnested -> + (case (value_ _valueOnested ) of + { ( !_valueIpp,!_valueIprec) -> + (case (({-# LINE 293 "PrintCode.ag" #-} + text "IntMap" >#< pp_parens _valueIpp + {-# LINE 3925 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 292 "PrintCode.ag" #-} + 5 + {-# LINE 3930 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) })) ) +sem_Type_TMap :: T_Type -> + T_Type -> + T_Type +sem_Type_TMap !(T_Type key_ ) !(T_Type value_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3941 "PrintCode.hs" #-} + )) of + { !_valueOnested -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3946 "PrintCode.hs" #-} + )) of + { !_keyOnested -> + (case (value_ _valueOnested ) of + { ( !_valueIpp,!_valueIprec) -> + (case (key_ _keyOnested ) of + { ( !_keyIpp,!_keyIprec) -> + (case (({-# LINE 291 "PrintCode.ag" #-} + text "Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp + {-# LINE 3955 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 290 "PrintCode.ag" #-} + 5 + {-# LINE 3960 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) })) ) +sem_Type_TMaybe :: T_Type -> + T_Type +sem_Type_TMaybe !(T_Type tp_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3970 "PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested ) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 287 "PrintCode.ag" #-} + text "Maybe" >#< _tpIpp + {-# LINE 3977 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 286 "PrintCode.ag" #-} + 5 + {-# LINE 3982 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) })) ) +sem_Type_TupleType :: T_Types -> + T_Type +sem_Type_TupleType !(T_Types tps_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 3992 "PrintCode.hs" #-} + )) of + { !_tpsOnested -> + (case (tps_ _tpsOnested ) of + { ( !_tpsIpps) -> + (case (({-# LINE 273 "PrintCode.ag" #-} + ppTuple _lhsInested _tpsIpps + {-# LINE 3999 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 272 "PrintCode.ag" #-} + 5 + {-# LINE 4004 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) })) ) +sem_Type_TypeApp :: T_Type -> + T_Types -> + T_Type +sem_Type_TypeApp !(T_Type func_ ) !(T_Types args_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 4015 "PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 4020 "PrintCode.hs" #-} + )) of + { !_funcOnested -> + (case (args_ _argsOnested ) of + { ( !_argsIpps) -> + (case (func_ _funcOnested ) of + { ( !_funcIpp,!_funcIprec) -> + (case (({-# LINE 265 "PrintCode.ag" #-} + hv_sp (_funcIpp : _argsIpps) + {-# LINE 4029 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 258 "PrintCode.ag" #-} + _funcIprec + {-# LINE 4034 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) })) ) +sem_Type_UnboxedTupleType :: T_Types -> + T_Type +sem_Type_UnboxedTupleType !(T_Types tps_ ) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 4044 "PrintCode.hs" #-} + )) of + { !_tpsOnested -> + (case (tps_ _tpsOnested ) of + { ( !_tpsIpps) -> + (case (({-# LINE 276 "PrintCode.ag" #-} + ppUnboxedTuple _lhsInested _tpsIpps + {-# LINE 4051 "PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 275 "PrintCode.ag" #-} + 5 + {-# LINE 4056 "PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) })) ) +-- Types ------------------------------------------------------- +{- + visit 0: + inherited attribute: + nested : Bool + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Type + child tl : Types + alternative Nil: +-} +-- cata +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 (Bool -> + ( PP_Docs)) +data Inh_Types = Inh_Types {nested_Inh_Types :: !(Bool)} +data Syn_Types = Syn_Types {pps_Syn_Types :: !(PP_Docs)} +wrap_Types :: T_Types -> + Inh_Types -> + Syn_Types +wrap_Types !(T_Types sem ) !(Inh_Types _lhsInested ) = + (let ( !_lhsOpps) = sem _lhsInested + in (Syn_Types _lhsOpps )) +sem_Types_Cons :: T_Type -> + T_Types -> + T_Types +sem_Types_Cons !(T_Type hd_ ) !(T_Types tl_ ) = + (T_Types (\ (!_lhsInested) -> + (case (({-# LINE 53 "PrintCode.ag" #-} + _lhsInested + {-# LINE 4096 "PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 51 "PrintCode.ag" #-} + _lhsInested + {-# LINE 4101 "PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested ) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested ) of + { ( !_hdIpp,!_hdIprec) -> + (case (({-# LINE 76 "PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 4110 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) })) ) +sem_Types_Nil :: T_Types +sem_Types_Nil = + (T_Types (\ (!_lhsInested) -> + (case (({-# LINE 77 "PrintCode.ag" #-} + [] + {-# LINE 4119 "PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) diff --git a/src-derived/PrintErrorMessages.hs b/src-derived/PrintErrorMessages.hs new file mode 100644 --- /dev/null +++ b/src-derived/PrintErrorMessages.hs @@ -0,0 +1,1772 @@ + + +-- UUAGC 0.9.38.1 (PrintErrorMessages.ag) +module PrintErrorMessages where +{-# LINE 4 "PrintErrorMessages.ag" #-} + +import Pretty +import UU.Scanner.Position(Pos(..), noPos) +import ErrorMessages +import DepTypes +import Options +import Data.List(mapAccumL,intersect,(\\)) +import GrammarInfo +{-# LINE 15 "../src-derived/PrintErrorMessages.hs" #-} + +{-# LINE 2 "./ErrorMessages.ag" #-} + +import UU.Scanner.Position(Pos) +import Pretty +import DepTypes(Trace) +import CodeSyntax +import CommonTypes +{-# LINE 24 "../src-derived/PrintErrorMessages.hs" #-} +{-# LINE 16 "PrintErrorMessages.ag" #-} + +isError :: Options -> Error -> Bool +isError opts (ParserError _ _ _ ) = True +isError opts (DupAlt _ _ _ ) = False +isError opts (DupSynonym _ _ ) = False +isError opts (DupSet _ _ ) = False +isError opts (DupInhAttr _ _ _ ) = True +isError opts (DupSynAttr _ _ _ ) = True +isError opts (DupChild _ _ _ _ ) = False +isError opts (DupRule _ _ _ _ _) = True +isError opts (DupSig _ _ _ ) = False +isError opts (UndefNont _ ) = True +isError opts (UndefAlt _ _ ) = True +isError opts (UndefChild _ _ _ ) = True +isError opts (MissingRule _ _ _ _ ) = False +isError opts (SuperfluousRule _ _ _ _ ) = False +isError opts (UndefLocal _ _ _ ) = True +isError opts (ChildAsLocal _ _ _ ) = False +isError opts (UndefAttr _ _ _ _ _) = True +isError opts (CyclicSet _ ) = True +isError opts (CustomError w _ _ ) = not w +isError opts (LocalCirc _ _ _ _ _) = cycleIsDangerous opts +isError opts (InstCirc _ _ _ _ _) = cycleIsDangerous opts +isError opts (DirectCirc _ _ _ ) = cycleIsDangerous opts +isError opts (InducedCirc _ _ _ ) = cycleIsDangerous opts +isError opts (MissingTypeSig _ _ _ ) = False +isError opts (MissingInstSig _ _ _ ) = True +isError opts (DupUnique _ _ _ ) = False +isError opts (MissingUnique _ _ ) = True +isError opts (MissingSyn _ _ ) = True +isError opts (MissingNamedRule _ _ _) = True +isError opts (DupRuleName _ _ _) = True +isError opts (HsParseError _ _) = True + +cycleIsDangerous :: Options -> Bool +cycleIsDangerous opts + = any ($ opts) [ wignore, bangpats, cases, strictCases, stricterCases, strictSems, withCycle ] +{-# LINE 63 "../src-derived/PrintErrorMessages.hs" #-} + +{-# LINE 506 "PrintErrorMessages.ag" #-} + +toWidth n xs | k-< indent 4 (vlist (map text path2)) + >-< text "and back: " + >-< indent 4 (vlist (map text path1)) + +attrText inh syn + = if inh == syn + then "threaded attribute " ++ getName inh + else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn + + +ppTrace :: Trace -> PP_Doc +ppTrace (tr:rest) = wfill [showLineNr (lineNr tr) ++ ":", "SEM", getName (nt tr), "|", getName (prod tr) + , lhsFld tr +.+ lhsAttr tr, "=", "..." +#+ showRhs tr +#+ "..."] + >-< ppTrace rest +ppTrace [] = empty + +showRhs :: TraceElem -> String +showRhs tr = if null (getName field) + then "@" ++ getName attr + else "@" ++ (field +.+ attr) + where field = rhsFld tr + attr = rhsAttr tr + +showLineNr :: Int -> String +showLineNr i | i==(-1) = "CR" + | otherwise = show i + +showAttrDef f a | f == _LHS = "synthesized attribute " ++ getName a + | f == _LOC = "local attribute " ++ getName a + | f == _INST = "inst attribute " ++ getName a + | otherwise = "inherited attribute " ++ getName a ++ " of field " ++ getName f + +showAttrUse f a | f == _LHS = "inherited attribute " ++ getName a + | f == _LOC = "local attribute " ++ getName a + | f == _INST = "inst attribute " ++ getName a + | otherwise = "synthesized attribute " ++ getName a ++ " of field " ++ getName f + +ppAttr f a = text (getName f++"."++getName a) +ppAttrUse f a = "@" >|< ppAttr f a +{-# LINE 115 "../src-derived/PrintErrorMessages.hs" #-} + +{-# LINE 558 "PrintErrorMessages.ag" #-} + +infixr 5 +#+ +(+#+) :: String -> String -> String +(+#+) s t = s ++ " " ++ t + +infixr 5 +.+ +(+.+) :: Identifier -> Identifier -> String +(+.+) s t = getName s ++ "." ++ getName t + +wfill = fill . addSpaces. concat . map words + where addSpaces (x:xs) = x:map addSpace xs + addSpaces [] = [] + addSpace [x] | x `elem` ".,;:!?" = [x] + addSpace xs = ' ':xs + +ppError :: Bool -- class of the error, True:error False:warning + -> Pos -- source position + -> PP_Doc -- error message + -> PP_Doc -- pattern + -> PP_Doc -- help, more info + -> PP_Doc -- action taken by AG + -> Bool -- verbose? show help and action? + -> PP_Doc +ppError isError pos mesg pat hlp act verbose + = let position = case pos of + Pos l c f | l >= 0 -> f >|< ":" >|< show l >|< ":" >|< show c + | otherwise -> pp "uuagc" + tp = if isError then "error" else "warning" + header = position >|< ":" >#< tp >|< ":" >#< mesg + pattern = "pattern :" >#< pat + help = "help :" >#< hlp + action = "action :" >#< act + in if verbose + then vlist [text "",header,pattern,help,action] + else header + +{- +-- old error reporting code + = let + cl = if isError then "ERROR" else "Warning" + position = case pos of + (Pos l c f) | l >= 0 -> f >|< ": line " >|< show l >|< ", column " >|< show c + | otherwise -> empty + header = "*** UU.AG" >#< cl >#< position >#< "***" + message = "problem :" >#< mesg + pattern = "pattern :" >#< pat + help = "help :" >#< hlp + action = "action :" >#< act + in + if verbose + then vlist [text "",header,message,pattern,help,action] + else vlist [text "",header,message] +-} + +showPos = show . getPos + +ppInterface inter = wfill ["interface:", show inter] + +{-# LINE 176 "../src-derived/PrintErrorMessages.hs" #-} +-- Error ------------------------------------------------------- +{- + visit 0: + inherited attributes: + options : Options + verbose : Bool + synthesized attributes: + me : SELF + pp : PP_Doc + alternatives: + alternative ChildAsLocal: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child var : {Identifier} + visit 0: + local me : _ + alternative CustomError: + child isWarning : {Bool} + child pos : {Pos} + child mesg : {PP_Doc} + visit 0: + local me : _ + alternative CyclicSet: + child name : {Identifier} + visit 0: + local me : _ + alternative DirectCirc: + child nt : {NontermIdent} + child o_visit : {Bool} + child cyclic : {[((Identifier,Identifier),[String],[String])]} + visit 0: + local me : _ + alternative DupAlt: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child occ1 : {ConstructorIdent} + visit 0: + local me : _ + alternative DupChild: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child name : {Identifier} + child occ1 : {Identifier} + visit 0: + local me : _ + alternative DupInhAttr: + child nt : {NontermIdent} + child attr : {Identifier} + child occ1 : {Identifier} + visit 0: + local me : _ + alternative DupRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + child occ1 : {Identifier} + visit 0: + local me : _ + alternative DupRuleName: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child nm : {Identifier} + visit 0: + local me : _ + alternative DupSet: + child name : {NontermIdent} + child occ1 : {NontermIdent} + visit 0: + local me : _ + alternative DupSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative DupSynAttr: + child nt : {NontermIdent} + child attr : {Identifier} + child occ1 : {Identifier} + visit 0: + local me : _ + alternative DupSynonym: + child nt : {NontermIdent} + child occ1 : {NontermIdent} + visit 0: + local me : _ + alternative DupUnique: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative HsParseError: + child pos : {Pos} + child msg : {String} + visit 0: + local me : _ + alternative InducedCirc: + child nt : {NontermIdent} + child cinter : {CInterface} + child cyclic : {[((Identifier,Identifier),[String],[String])]} + visit 0: + local me : _ + alternative InstCirc: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + child o_visit : {Bool} + child path : {[String]} + visit 0: + local me : _ + alternative LocalCirc: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + child o_visit : {Bool} + child path : {[String]} + visit 0: + local me : _ + alternative MissingInstSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative MissingNamedRule: + child nt : {NontermIdent} + child con : {Identifier} + child name : {Identifier} + visit 0: + local me : _ + alternative MissingRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + visit 0: + local me : _ + alternative MissingSyn: + child nt : {NontermIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative MissingTypeSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative MissingUnique: + child nt : {NontermIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative ParserError: + child pos : {Pos} + child problem : {String} + child action : {String} + visit 0: + local me : _ + alternative SuperfluousRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + visit 0: + local me : _ + alternative UndefAlt: + child nt : {NontermIdent} + child con : {ConstructorIdent} + visit 0: + local me : _ + alternative UndefAttr: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + child isOut : {Bool} + visit 0: + local me : _ + alternative UndefChild: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child name : {Identifier} + visit 0: + local me : _ + alternative UndefLocal: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child var : {Identifier} + visit 0: + local me : _ + alternative UndefNont: + child nt : {NontermIdent} + visit 0: + local me : _ +-} +-- cata +sem_Error :: Error -> + T_Error +sem_Error (ChildAsLocal _nt _con _var ) = + (sem_Error_ChildAsLocal _nt _con _var ) +sem_Error (CustomError _isWarning _pos _mesg ) = + (sem_Error_CustomError _isWarning _pos _mesg ) +sem_Error (CyclicSet _name ) = + (sem_Error_CyclicSet _name ) +sem_Error (DirectCirc _nt _o_visit _cyclic ) = + (sem_Error_DirectCirc _nt _o_visit _cyclic ) +sem_Error (DupAlt _nt _con _occ1 ) = + (sem_Error_DupAlt _nt _con _occ1 ) +sem_Error (DupChild _nt _con _name _occ1 ) = + (sem_Error_DupChild _nt _con _name _occ1 ) +sem_Error (DupInhAttr _nt _attr _occ1 ) = + (sem_Error_DupInhAttr _nt _attr _occ1 ) +sem_Error (DupRule _nt _con _field _attr _occ1 ) = + (sem_Error_DupRule _nt _con _field _attr _occ1 ) +sem_Error (DupRuleName _nt _con _nm ) = + (sem_Error_DupRuleName _nt _con _nm ) +sem_Error (DupSet _name _occ1 ) = + (sem_Error_DupSet _name _occ1 ) +sem_Error (DupSig _nt _con _attr ) = + (sem_Error_DupSig _nt _con _attr ) +sem_Error (DupSynAttr _nt _attr _occ1 ) = + (sem_Error_DupSynAttr _nt _attr _occ1 ) +sem_Error (DupSynonym _nt _occ1 ) = + (sem_Error_DupSynonym _nt _occ1 ) +sem_Error (DupUnique _nt _con _attr ) = + (sem_Error_DupUnique _nt _con _attr ) +sem_Error (HsParseError _pos _msg ) = + (sem_Error_HsParseError _pos _msg ) +sem_Error (InducedCirc _nt _cinter _cyclic ) = + (sem_Error_InducedCirc _nt _cinter _cyclic ) +sem_Error (InstCirc _nt _con _attr _o_visit _path ) = + (sem_Error_InstCirc _nt _con _attr _o_visit _path ) +sem_Error (LocalCirc _nt _con _attr _o_visit _path ) = + (sem_Error_LocalCirc _nt _con _attr _o_visit _path ) +sem_Error (MissingInstSig _nt _con _attr ) = + (sem_Error_MissingInstSig _nt _con _attr ) +sem_Error (MissingNamedRule _nt _con _name ) = + (sem_Error_MissingNamedRule _nt _con _name ) +sem_Error (MissingRule _nt _con _field _attr ) = + (sem_Error_MissingRule _nt _con _field _attr ) +sem_Error (MissingSyn _nt _attr ) = + (sem_Error_MissingSyn _nt _attr ) +sem_Error (MissingTypeSig _nt _con _attr ) = + (sem_Error_MissingTypeSig _nt _con _attr ) +sem_Error (MissingUnique _nt _attr ) = + (sem_Error_MissingUnique _nt _attr ) +sem_Error (ParserError _pos _problem _action ) = + (sem_Error_ParserError _pos _problem _action ) +sem_Error (SuperfluousRule _nt _con _field _attr ) = + (sem_Error_SuperfluousRule _nt _con _field _attr ) +sem_Error (UndefAlt _nt _con ) = + (sem_Error_UndefAlt _nt _con ) +sem_Error (UndefAttr _nt _con _field _attr _isOut ) = + (sem_Error_UndefAttr _nt _con _field _attr _isOut ) +sem_Error (UndefChild _nt _con _name ) = + (sem_Error_UndefChild _nt _con _name ) +sem_Error (UndefLocal _nt _con _var ) = + (sem_Error_UndefLocal _nt _con _var ) +sem_Error (UndefNont _nt ) = + (sem_Error_UndefNont _nt ) +-- semantic domain +newtype T_Error = T_Error (Options -> + Bool -> + ( Error ,PP_Doc)) +data Inh_Error = Inh_Error {options_Inh_Error :: Options,verbose_Inh_Error :: Bool} +data Syn_Error = Syn_Error {me_Syn_Error :: Error ,pp_Syn_Error :: PP_Doc} +wrap_Error :: T_Error -> + Inh_Error -> + Syn_Error +wrap_Error (T_Error sem ) (Inh_Error _lhsIoptions _lhsIverbose ) = + (let ( _lhsOme,_lhsOpp) = sem _lhsIoptions _lhsIverbose + in (Syn_Error _lhsOme _lhsOpp )) +sem_Error_ChildAsLocal :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_ChildAsLocal nt_ con_ var_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 341, column 21) + _lhsOpp = + ({-# LINE 341 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Nontrivial field ",getName var_, "is used as local at constructor" + , getName con_ , "of nonterminal",getName nt_, "." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "... = " + >#< "..." >#< "@" >|< getName var_ >#< "..." ) + help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" + , getName nt_ , "contains a nontrivial field name", getName var_, "." + ,"You should use @", getName var_, ".self instead, where self is a SELF-attribute." + ] + act = wfill ["The generated program probably contains a type error or has undefined variables."] + in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose + {-# LINE 476 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + ChildAsLocal nt_ con_ var_ + {-# LINE 482 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 488 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_CustomError :: Bool -> + Pos -> + PP_Doc -> + T_Error +sem_Error_CustomError isWarning_ pos_ mesg_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 383, column 21) + _lhsOpp = + ({-# LINE 383 "PrintErrorMessages.ag" #-} + let pat = text "unknown" + help = wfill ["not available."] + act = wfill ["unknown"] + in ppError (isError _lhsIoptions _me) pos_ mesg_ pat help act False + {-# LINE 507 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + CustomError isWarning_ pos_ mesg_ + {-# LINE 513 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 519 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_CyclicSet :: Identifier -> + T_Error +sem_Error_CyclicSet name_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 374, column 21) + _lhsOpp = + ({-# LINE 374 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Cyclic definition for nonterminal set", getName name_] + pat = "SET" >#< getName name_ >#< "=" >#< "..." >#< getName name_ >#< "..." + help = wfill ["The defintion for a nonterminal set named" , getName name_ + ,"directly or indirectly refers to itself." + ,"Adapt the definition of the nonterminal set, to remove the cyclic dependency." + ] + act = wfill ["The nonterminal set", getName name_, "is considered to be empty."] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 540 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + CyclicSet name_ + {-# LINE 546 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 552 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DirectCirc :: NontermIdent -> + Bool -> + ([((Identifier,Identifier),[String],[String])]) -> + T_Error +sem_Error_DirectCirc nt_ o_visit_ cyclic_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 412, column 21) + _lhsOpp = + ({-# LINE 412 "PrintErrorMessages.ag" #-} + let mesg = wfill ["In nonterminal", getName nt_, "synthesized and inherited attributes are mutually dependent" ] + >-< vlist (map showEdge cyclic_) + pat = text "" + help = vlist (map showEdgeLong cyclic_) + act | o_visit_ = text "An unoptimized version was generated. It might hang when run." + | otherwise = text "The generated program might hang when run." + in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose + {-# LINE 574 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DirectCirc nt_ o_visit_ cyclic_ + {-# LINE 580 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 586 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupAlt :: NontermIdent -> + ConstructorIdent -> + ConstructorIdent -> + T_Error +sem_Error_DupAlt nt_ con_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 87, column 21) + _lhsOpp = + ({-# LINE 87 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Repeated definition for alternative", getName con_ + ,"of nonterminal", getName nt_, "." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Other definition:", (showPos con_),"."] + pat = "DATA" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "...") + >-< indent 2 ("|" >#< getName con_ >#< "...") + help = wfill ["The nonterminal",getName nt_,"has more than one alternative that" + ,"is labelled with the constructor name",getName con_,"." + ,"You should either rename or remove enough of them to make all" + ,"constructors of",getName nt_,"uniquely named." + ] + act = wfill [ "The first alternative of name",getName con_ + ,"you have given for nonterminal",getName nt_ + ,"is considered valid. All other alternatives have been discarded." + ] + in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose + {-# LINE 619 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupAlt nt_ con_ occ1_ + {-# LINE 625 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 631 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupChild :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_DupChild nt_ con_ name_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 180, column 21) + _lhsOpp = + ({-# LINE 180 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative" + ,getName con_, "of nonterminal", getName nt_, "." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Other definition:", (showPos name_),"."] + pat = "DATA" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< (getName name_ >|< ":..." >-< getName name_ >|< ":...")) + help = wfill ["The alternative" ,getName con_ , "of nonterminal" ,getName nt_ + ,"has more than one field that is named" + , getName name_ ++ ". Possibly they have different types." + ,"You should either rename or remove enough of them to make all fields of" + ,getName con_ , "for nonterminal " , getName nt_ , "uniquely named." + ] + act = wfill ["The last declaration with its corresponding type is considered valid." + ,"All others have been discarded." + ] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 664 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupChild nt_ con_ name_ occ1_ + {-# LINE 670 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 676 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupInhAttr :: NontermIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_DupInhAttr nt_ attr_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 142, column 21) + _lhsOpp = + ({-# LINE 142 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_ + , "of nonterminal", getName nt_, "." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Other definition:", (showPos attr_),"."] + pat = "ATTR" >#< getName nt_ >#< "[" >#< getName attr_ >|< ":...," + >#< getName attr_ >|< ":... | | ]" + help = wfill ["The identifier" , getName attr_ ,"has been declared" + ,"as an inherited (or chained) attribute for nonterminal" + ,getName nt_ , "more than once, with possibly different types." + ,"Delete all but one or rename them to make them unique." + ] + act = wfill ["One declaration with its corresponding type is considered valid." + ,"All others have been discarded. The generated program will probably not run." + ] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 707 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupInhAttr nt_ attr_ occ1_ + {-# LINE 713 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 719 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupRule :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + Identifier -> + T_Error +sem_Error_DupRule nt_ con_ field_ attr_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 200, column 21) + _lhsOpp = + ({-# LINE 200 "PrintErrorMessages.ag" #-} + let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rules for" + ,showAttrDef field_ attr_,"." + ] >-< + wfill ["First rule:", (showPos occ1_),"."] >-< + wfill ["Other rule:", (showPos attr_),"."] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") + >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") + help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", there is more than one rule for the" , showAttrDef field_ attr_ + ,". You should either rename or remove enough of them to make all rules for alternative" + ,getName con_ , "of nonterminal " ,getName nt_ , "uniquely named." + ] + act = wfill ["The last rule given is considered valid. All others have been discarded."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 751 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupRule nt_ con_ field_ attr_ occ1_ + {-# LINE 757 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 763 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupRuleName :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_DupRuleName nt_ con_ nm_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 218, column 21) + _lhsOpp = + ({-# LINE 218 "PrintErrorMessages.ag" #-} + let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rule names for" + ,show nm_,"." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< show nm_ >#< ": ... = ...") + >-< indent 2 ("|" >#< getName con_ >#< show nm_ >#< ": ... = ...") + help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", there is more than one rule name " , show nm_ + ,". You should either rename or remove enough of them." + ] + act = wfill ["Compilation cannot continue."] + in ppError (isError _lhsIoptions _me) (getPos nm_) mesg pat help act _lhsIverbose + {-# LINE 790 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupRuleName nt_ con_ nm_ + {-# LINE 796 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 802 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupSet :: NontermIdent -> + NontermIdent -> + T_Error +sem_Error_DupSet name_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 126, column 21) + _lhsOpp = + ({-# LINE 126 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Definition of nonterminal set", getName name_, "clashes with another" + ,"set, a type synonym or a data definition." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Set definition:" , (showPos name_),"."] + pat = "SET" >#< getName name_ >#< "=" >#< "..." + >-< "SET" >#< getName name_ >#< "=" >#< "..." + help = wfill ["A nonterminal set with name", getName name_ + ,"has been given while there already is a SET, DATA, or TYPE" + ,"definition with the same name." + ,"You should either rename or remove the nonterminal set." + ] + act = wfill [ "The clashing nonterminal set will be ignored." + ] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 831 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupSet name_ occ1_ + {-# LINE 837 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 843 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupSig :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_DupSig nt_ con_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 233, column 21) + _lhsOpp = + ({-# LINE 233 "PrintErrorMessages.ag" #-} + let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more typesignatures for" + ,showAttrDef _LOC attr_,"." + ] >-< + wfill ["First signature:", (showPos attr_),"."] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...") + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...") + help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", there is more than one rule for the" , showAttrDef _LOC attr_ + ,". You should remove enough of them to make all typesignatures for alternative" + ,getName con_ , "of nonterminal " ,getName nt_ , "unique." + ] + act = wfill ["The last typesignature given is considered valid. All others have been discarded."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 872 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupSig nt_ con_ attr_ + {-# LINE 878 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 884 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupSynAttr :: NontermIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_DupSynAttr nt_ attr_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 161, column 21) + _lhsOpp = + ({-# LINE 161 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_ + , "of nonterminal", getName nt_, "." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Other definition:", (showPos attr_),"."] + pat = "ATTR" >#< getName nt_ >#< "[ | |" >#< getName attr_ >|< ":...," + >#< getName attr_ >|< ":... ]" + help = wfill ["The identifier" , getName attr_ ,"has been declared" + ,"as a synthesized (or chained) attribute for nonterminal" + ,getName nt_ , "more than once, with possibly different types." + ,"Delete all but one or rename them to make them unique." + ] + act = wfill ["One declaration with its corresponding type is considered valid." + ,"All others have been discarded. The generated program will probably not run." + ] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 915 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupSynAttr nt_ attr_ occ1_ + {-# LINE 921 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 927 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupSynonym :: NontermIdent -> + NontermIdent -> + T_Error +sem_Error_DupSynonym nt_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 109, column 21) + _lhsOpp = + ({-# LINE 109 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another" + ,"type synonym." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Type synonym :" , (showPos nt_),"."] + pat = "DATA" >#< getName nt_ + >-< indent 2 ("|" >#< "...") + >-< "TYPE" >#< getName nt_ >#< "=" >#< "..." + help = wfill ["A type synonym with name", getName nt_ + ,"has been given while there already is TYPE" + ,"definition with the same name." + ,"You should either rename or remove the type synonym." + ] + act = wfill [ "The clashing type synonym will be ignored." + ] + in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose + {-# LINE 957 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupSynonym nt_ occ1_ + {-# LINE 963 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 969 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_DupUnique :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_DupUnique nt_ con_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 473, column 21) + _lhsOpp = + ({-# LINE 473 "PrintErrorMessages.ag" #-} + let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more unique-attribute signatures for" + ,showAttrDef _LOC attr_,"." + ] >-< + wfill ["First signature:", (showPos attr_),"."] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...") + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...") + help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", there is more than one unique-attribute signature for the" , showAttrDef _LOC attr_ + ,". You should remove enough of them to make all unique-signatures for alternative" + ,getName con_ , "of nonterminal " ,getName nt_ , "unique." + ] + act = wfill ["Unpredicatable sharing of unique numbers may occur."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 998 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + DupUnique nt_ con_ attr_ + {-# LINE 1004 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1010 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_HsParseError :: Pos -> + String -> + T_Error +sem_Error_HsParseError pos_ msg_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 85, column 21) + _lhsOpp = + ({-# LINE 85 "PrintErrorMessages.ag" #-} + ppError True pos_ (text msg_) (text "") (text "") (text "Correct the syntax of the Haskell code.") _lhsIverbose + {-# LINE 1025 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + HsParseError pos_ msg_ + {-# LINE 1031 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1037 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_InducedCirc :: NontermIdent -> + CInterface -> + ([((Identifier,Identifier),[String],[String])]) -> + T_Error +sem_Error_InducedCirc nt_ cinter_ cyclic_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 420, column 21) + _lhsOpp = + ({-# LINE 420 "PrintErrorMessages.ag" #-} + let mesg = wfill ["After scheduling, in nonterminal", getName nt_, "synthesized and inherited attributes have an INDUCED mutual dependency" ] + >-< vlist (map showEdge cyclic_) + pat = text "" + showInter (CInterface segs) = concat (snd (mapAccumL (\i c -> (i+1,("visit " ++ show i) : map ind (showsSegment c))) 0 segs)) + help = vlist (("Interface for nonterminal " ++ getName nt_ ++ ":") : map ind (showInter cinter_)) + >-< vlist (map showEdgeLong cyclic_) + act = text "An unoptimized version was generated. It might hang when run." + in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose + {-# LINE 1060 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + InducedCirc nt_ cinter_ cyclic_ + {-# LINE 1066 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1072 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_InstCirc :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Bool -> + ([String]) -> + T_Error +sem_Error_InstCirc nt_ con_ attr_ o_visit_ path_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 400, column 21) + _lhsOpp = + ({-# LINE 400 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Circular dependency for inst attribute", getName attr_ + , "of alternative", getName con_, "of nonterminal", getName nt_] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "inst." >|< getName attr_ >#< "=" + >#< "..." >#< "@s." >#< "...") + help = if null path_ + then text "the definition is directly circular" + else hlist ("The following attributes are involved in the cycle:": path_) + act | o_visit_ = text "An unoptimized version was generated. It might hang when run." + | otherwise = text "The generated program might hang when run." + in ppError (isError _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose + {-# LINE 1100 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + InstCirc nt_ con_ attr_ o_visit_ path_ + {-# LINE 1106 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1112 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_LocalCirc :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Bool -> + ([String]) -> + T_Error +sem_Error_LocalCirc nt_ con_ attr_ o_visit_ path_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 388, column 21) + _lhsOpp = + ({-# LINE 388 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Circular dependency for local attribute", getName attr_ + , "of alternative", getName con_, "of nonterminal", getName nt_] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "loc." >|< getName attr_ >#< "=" + >#< "..." >#< "@loc." >|< getName attr_ >#< "...") + help = if null path_ + then text "the definition is directly circular" + else hlist ("The following attributes are involved in the cycle:": path_) + act | o_visit_ = text "An unoptimized version was generated. It might hang when run." + | otherwise = text "The generated program might hang when run." + in ppError (isError _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose + {-# LINE 1140 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + LocalCirc nt_ con_ attr_ o_visit_ path_ + {-# LINE 1146 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1152 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_MissingInstSig :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_MissingInstSig nt_ con_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 443, column 21) + _lhsOpp = + ({-# LINE 443 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST attr_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,"." + ]>-< + wfill ["Location:", (showPos attr_),"."] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _INST attr_ >#< ": ...") + help = wfill ["The", showAttrDef _INST attr_, "in alternative", getName con_ + ,"of nonterminal", getName nt_, "is a non-terminal attribute, so " + ,"its type is needed to attribute its value." + ,"Please supply its type." + ] + act = wfill ["It is not possible to proceed without this signature."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1180 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + MissingInstSig nt_ con_ attr_ + {-# LINE 1186 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1192 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_MissingNamedRule :: NontermIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_MissingNamedRule nt_ con_ name_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 300, column 23) + _lhsOpp = + ({-# LINE 300 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Missing rule name ", show name_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,"." + ] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< show name_ >#< ": ... = ...") + help = wfill ["There is a dependency on a rule with name ", show name_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,", but no rule has been defined with this name. Maybe you misspelled it?" + ] + act = wfill ["Compilation cannot continue."] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 1217 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + MissingNamedRule nt_ con_ name_ + {-# LINE 1223 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1229 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_MissingRule :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_MissingRule nt_ con_ field_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 287, column 21) + _lhsOpp = + ({-# LINE 287 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,"." + ] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") + help = wfill ["The", showAttrDef field_ attr_, "in alternative", getName con_ + , "of nonterminal", getName nt_, "is missing and cannot be inferred" + ,"by a copy rule, so you should add an appropriate rule." + ] + act = wfill ["The value of the attribute has been set to undefined."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1256 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + MissingRule nt_ con_ field_ attr_ + {-# LINE 1262 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1268 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_MissingSyn :: NontermIdent -> + Identifier -> + T_Error +sem_Error_MissingSyn nt_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 490, column 20) + _lhsOpp = + ({-# LINE 490 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Missing synthesized attribute" + , getName attr_ + , "at nonterminal" + , getName nt_, "." + ] + pat = "ATTR" >#< getName nt_ >#< "[ | | " >#< getName attr_ >#< " : ... ]" + help = wfill ["An augment rule for a constructor for nonterminal" , getName nt_ + , "refers to a synthesized attribute named " + , getName attr_ + ,"Maybe you misspelled it?" + ,"Otherwise add an appropriate attribute definition." + ] + act = wfill ["It is not possible to proceed without this declaration."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1296 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + MissingSyn nt_ attr_ + {-# LINE 1302 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1308 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_MissingTypeSig :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_MissingTypeSig nt_ con_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 429, column 21) + _lhsOpp = + ({-# LINE 429 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC attr_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,"." + ]>-< + wfill ["Location:", (showPos attr_),"."] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< ": ...") + help = wfill ["The", showAttrDef _LOC attr_, "in alternative", getName con_ + ,"of nonterminal", getName nt_, "is needed in two separate visits to", getName nt_ + ,"so its type is needed to generate type signatures." + ,"Please supply its type." + ] + act = wfill ["The type signatures of semantic functions are not generated."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1336 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + MissingTypeSig nt_ con_ attr_ + {-# LINE 1342 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1348 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_MissingUnique :: NontermIdent -> + Identifier -> + T_Error +sem_Error_MissingUnique nt_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 457, column 21) + _lhsOpp = + ({-# LINE 457 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Missing unique counter (chained attribute)" + , getName attr_ + , "at nonterminal" + , getName nt_, "." + ] + pat = "ATTR" >#< getName nt_ >#< "[ |" >#< getName attr_ >#< " : ... | ]" + help = wfill ["A unique attribute signature in a constructor for nonterminal" , getName nt_ + , "refers to an unique counter (chained attribute) named " + , getName attr_ + ,"Maybe you misspelled it?" + ,"Otherwise either remove the signature or add an appropriate attribute definition." + ] + act = wfill ["It is not possible to proceed without this declaration."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1376 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + MissingUnique nt_ attr_ + {-# LINE 1382 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1388 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_ParserError :: Pos -> + String -> + String -> + T_Error +sem_Error_ParserError pos_ problem_ action_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 79, column 21) + _lhsOpp = + ({-# LINE 79 "PrintErrorMessages.ag" #-} + let mesg = text ("parser expecting " ++ problem_) + pat = text "" + help = text "" + act = text action_ + in ppError (isError _lhsIoptions _me) pos_ mesg pat help act _lhsIverbose + {-# LINE 1408 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + ParserError pos_ problem_ action_ + {-# LINE 1414 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1420 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_SuperfluousRule :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_SuperfluousRule nt_ con_ field_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 312, column 21) + _lhsOpp = + ({-# LINE 312 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative" + , getName con_ , "of nonterminal",getName nt_, "." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") + help = wfill ["There is a rule for" , showAttrDef field_ attr_ , "in the definitions for alternative" , getName con_ + ,"of nonterminal" , getName nt_, ", but this attribute does not exist. Maybe you misspelled it?" + ,"Otherwise either remove the rule or add an appropriate attribute definition." + ] + act = wfill ["The rule has been ignored."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1447 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + SuperfluousRule nt_ con_ field_ attr_ + {-# LINE 1453 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1459 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_UndefAlt :: NontermIdent -> + ConstructorIdent -> + T_Error +sem_Error_UndefAlt nt_ con_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 260, column 21) + _lhsOpp = + ({-# LINE 260 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined." + ] + pat = "DATA" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "...") + help = wfill ["There are rules for alternative", getName con_ , "of nonterminal" ,getName nt_ + ,", but there is no definition for this alternative in the definitions of the" + ,"nonterminal" , getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." + ] + act = wfill ["All rules for the unknown alternative have been ignored."] + in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose + {-# LINE 1483 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + UndefAlt nt_ con_ + {-# LINE 1489 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1495 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_UndefAttr :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + Bool -> + T_Error +sem_Error_UndefAttr nt_ con_ field_ attr_ isOut_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 355, column 21) + _lhsOpp = + ({-# LINE 355 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Undefined" + , if isOut_ + then showAttrDef field_ attr_ + else showAttrUse field_ attr_ + , "at constructor" + , getName con_ , "of nonterminal",getName nt_, "." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ". = " + >#< "..." >#< ppAttrUse field_ attr_ >#< "...") + help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" + ,getName nt_ , "contains an attribute that is not defined" + ,"Maybe you misspelled it?" + ,"Otherwise either remove the rule or add an appropriate attribute definition." + ] + act = wfill ["The generated program will not run."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1529 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + UndefAttr nt_ con_ field_ attr_ isOut_ + {-# LINE 1535 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1541 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_UndefChild :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_UndefChild nt_ con_ name_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 272, column 21) + _lhsOpp = + ({-# LINE 272 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_ + , "does not have a nontrivial field named", getName name_ , "." + ] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr name_ (identifier "") >#< "= ...") + help = wfill ["There are rules that define or use attributes of field" , getName name_ + ,"in alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", but there is no field with AG-type in the definition of the alternative." + ,"Maybe you misspelled it? Otherwise insert the field into the definition," + ,"or change its type from an HS-type to an AG-type." + ] + act = wfill ["All rules for the unknown field have been ignored."] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 1569 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + UndefChild nt_ con_ name_ + {-# LINE 1575 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1581 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_UndefLocal :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_UndefLocal nt_ con_ var_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 326, column 21) + _lhsOpp = + ({-# LINE 326 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor" + , getName con_ , "of nonterminal",getName nt_, "." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ". = " + >#< "..." >#< "@" >|< getName var_ >#< "..." ) + help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" + , getName nt_ , "contains a local variable or field name that is not defined. " + ,"Maybe you misspelled it?" + ,"Otherwise either remove the rule or add an appropriate definition." + ] + act = wfill ["The generated program will not run."] + in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose + {-# LINE 1609 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + UndefLocal nt_ con_ var_ + {-# LINE 1615 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1621 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +sem_Error_UndefNont :: NontermIdent -> + T_Error +sem_Error_UndefNont nt_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 250, column 21) + _lhsOpp = + ({-# LINE 250 "PrintErrorMessages.ag" #-} + let mesg = wfill ["Nonterminal", getName nt_, "is not defined." + ] + pat = "DATA" >#< getName nt_ >#< "..." + help = wfill ["There are attributes and/or rules for nonterminal" , getName nt_ ,", but there is no definition" + , "for" ,getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." + ] + act = wfill ["Everything regarding the unknown nonterminal has been ignored."] + in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose + {-# LINE 1642 "PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + UndefNont nt_ + {-# LINE 1648 "PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 61 "PrintErrorMessages.ag" #-} + _me + {-# LINE 1654 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp))) ) +-- Errors ------------------------------------------------------ +{- + visit 0: + inherited attributes: + dups : [String] + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Cons: + child hd : Error + child tl : Errors + visit 0: + local verbose : _ + local str : _ + alternative Nil: + visit 0: + local verbose : _ +-} +-- cata +sem_Errors :: Errors -> + T_Errors +sem_Errors list = + (Prelude.foldr sem_Errors_Cons sem_Errors_Nil (Prelude.map sem_Error list) ) +-- semantic domain +newtype T_Errors = T_Errors (([String]) -> + Options -> + ( PP_Doc)) +data Inh_Errors = Inh_Errors {dups_Inh_Errors :: ([String]),options_Inh_Errors :: Options} +data Syn_Errors = Syn_Errors {pp_Syn_Errors :: PP_Doc} +wrap_Errors :: T_Errors -> + Inh_Errors -> + Syn_Errors +wrap_Errors (T_Errors sem ) (Inh_Errors _lhsIdups _lhsIoptions ) = + (let ( _lhsOpp) = sem _lhsIdups _lhsIoptions + in (Syn_Errors _lhsOpp )) +sem_Errors_Cons :: T_Error -> + T_Errors -> + T_Errors +sem_Errors_Cons (T_Error hd_ ) (T_Errors tl_ ) = + (T_Errors (\ _lhsIdups + _lhsIoptions -> + (let _lhsOpp :: PP_Doc + _tlOdups :: ([String]) + _hdOoptions :: Options + _hdOverbose :: Bool + _tlOoptions :: Options + _hdIme :: Error + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + -- "PrintErrorMessages.ag"(line 68, column 8) + _verbose = + ({-# LINE 68 "PrintErrorMessages.ag" #-} + verbose _lhsIoptions + {-# LINE 1711 "PrintErrorMessages.hs" #-} + ) + -- "PrintErrorMessages.ag"(line 69, column 11) + _str = + ({-# LINE 69 "PrintErrorMessages.ag" #-} + disp _hdIpp 5000 "" + {-# LINE 1717 "PrintErrorMessages.hs" #-} + ) + -- "PrintErrorMessages.ag"(line 71, column 11) + _lhsOpp = + ({-# LINE 71 "PrintErrorMessages.ag" #-} + if _str `elem` _lhsIdups + then _tlIpp + else _hdIpp >-< _tlIpp + {-# LINE 1725 "PrintErrorMessages.hs" #-} + ) + -- "PrintErrorMessages.ag"(line 74, column 11) + _tlOdups = + ({-# LINE 74 "PrintErrorMessages.ag" #-} + _str : _lhsIdups + {-# LINE 1731 "PrintErrorMessages.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 60 "PrintErrorMessages.ag" #-} + _lhsIoptions + {-# LINE 1737 "PrintErrorMessages.hs" #-} + ) + -- copy rule (from local) + _hdOverbose = + ({-# LINE 60 "PrintErrorMessages.ag" #-} + _verbose + {-# LINE 1743 "PrintErrorMessages.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 64 "PrintErrorMessages.ag" #-} + _lhsIoptions + {-# LINE 1749 "PrintErrorMessages.hs" #-} + ) + ( _hdIme,_hdIpp) = + hd_ _hdOoptions _hdOverbose + ( _tlIpp) = + tl_ _tlOdups _tlOoptions + in ( _lhsOpp))) ) +sem_Errors_Nil :: T_Errors +sem_Errors_Nil = + (T_Errors (\ _lhsIdups + _lhsIoptions -> + (let _lhsOpp :: PP_Doc + -- "PrintErrorMessages.ag"(line 68, column 8) + _verbose = + ({-# LINE 68 "PrintErrorMessages.ag" #-} + verbose _lhsIoptions + {-# LINE 1765 "PrintErrorMessages.hs" #-} + ) + -- "PrintErrorMessages.ag"(line 75, column 11) + _lhsOpp = + ({-# LINE 75 "PrintErrorMessages.ag" #-} + text "" + {-# LINE 1771 "PrintErrorMessages.hs" #-} + ) + in ( _lhsOpp))) ) diff --git a/src-derived/PrintOcamlCode.hs b/src-derived/PrintOcamlCode.hs new file mode 100644 --- /dev/null +++ b/src-derived/PrintOcamlCode.hs @@ -0,0 +1,2230 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.38.1 (PrintOcamlCode.ag) +module PrintOcamlCode where +{-# LINE 10 "PrintOcamlCode.ag" #-} + +import Pretty +import Code +import Patterns +import Options +import CommonTypes hiding (List,Type,Map,Maybe,IntMap,Either) +import Data.List(intersperse,intercalate) +import Data.Char(toLower) +{-# LINE 15 "../src-derived/PrintOcamlCode.hs" #-} + +{-# LINE 2 "./Code.ag" #-} + +import Pretty +import Patterns +import Data.List(partition) +import Data.Set(Set) +import qualified Data.Set as Set +import Data.Map(Map) +import qualified Data.Map as Map +{-# LINE 26 "../src-derived/PrintOcamlCode.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 33 "../src-derived/PrintOcamlCode.hs" #-} +{-# LINE 21 "PrintOcamlCode.ag" #-} + +type PP_Docs = [PP_Doc] + +ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeqH = ppMultiSeq' (>#<) + +ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeqV = ppMultiSeq' (>-<) + +ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeq' next strictArgs expr + = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs + +ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps +ppTuple False pps = "(" >|< pp_block " " ")" "," pps +{-# LINE 50 "../src-derived/PrintOcamlCode.hs" #-} + +{-# LINE 174 "PrintOcamlCode.ag" #-} + +toOcamlTC (c:cs) = toLower c : cs +toOcamlTC xs = xs +{-# LINE 56 "../src-derived/PrintOcamlCode.hs" #-} + +{-# LINE 145 "./Code.ag" #-} + +-- Unboxed tuples +-- unbox Whether unboxed tuples are wanted or not +-- inh The inherited attributes. +-- If there are none, no unboxing can take place, +-- because in that case the semantic function (a top-level identifier) would have an unboxed type. +-- Of course we can't have an unboxed 1-tuple +mkTupleExpr :: Bool -> Bool -> Exprs -> Expr +mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs + | otherwise = UnboxedTupleExpr exprs +mkTupleType :: Bool -> Bool -> Types -> Type +mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps + | otherwise = UnboxedTupleType tps +mkTupleLhs :: Bool -> Bool -> [String] -> Lhs +mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps + | otherwise = UnboxedTupleLhs comps +{-# LINE 75 "../src-derived/PrintOcamlCode.hs" #-} +-- CaseAlt ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CaseAlt: + child left : Lhs + child expr : Expr +-} +-- cata +sem_CaseAlt :: CaseAlt -> + T_CaseAlt +sem_CaseAlt !(CaseAlt _left _expr ) = + (sem_CaseAlt_CaseAlt (sem_Lhs _left ) (sem_Expr _expr ) ) +-- semantic domain +newtype T_CaseAlt = T_CaseAlt (Options -> + ( PP_Doc)) +data Inh_CaseAlt = Inh_CaseAlt {options_Inh_CaseAlt :: !(Options)} +data Syn_CaseAlt = Syn_CaseAlt {pp_Syn_CaseAlt :: !(PP_Doc)} +wrap_CaseAlt :: T_CaseAlt -> + Inh_CaseAlt -> + Syn_CaseAlt +wrap_CaseAlt !(T_CaseAlt sem ) !(Inh_CaseAlt _lhsIoptions ) = + (let ( !_lhsOpp) = sem _lhsIoptions + in (Syn_CaseAlt _lhsOpp )) +sem_CaseAlt_CaseAlt :: T_Lhs -> + T_Expr -> + T_CaseAlt +sem_CaseAlt_CaseAlt !(T_Lhs left_ ) !(T_Expr expr_ ) = + (T_CaseAlt (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 111 "PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions ) of + { ( !_exprIpp) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 118 "PrintOcamlCode.hs" #-} + )) of + { !_leftOoptions -> + (case (left_ _leftOoptions ) of + { ( !_leftIpp) -> + (case (({-# LINE 180 "PrintOcamlCode.ag" #-} + _leftIpp >#< "->" >#< _exprIpp + {-# LINE 125 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +-- CaseAlts ---------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : CaseAlt + child tl : CaseAlts + alternative Nil: +-} +-- cata +sem_CaseAlts :: CaseAlts -> + T_CaseAlts +sem_CaseAlts !list = + (Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list) ) +-- semantic domain +newtype T_CaseAlts = T_CaseAlts (Options -> + ( PP_Docs)) +data Inh_CaseAlts = Inh_CaseAlts {options_Inh_CaseAlts :: !(Options)} +data Syn_CaseAlts = Syn_CaseAlts {pps_Syn_CaseAlts :: !(PP_Docs)} +wrap_CaseAlts :: T_CaseAlts -> + Inh_CaseAlts -> + Syn_CaseAlts +wrap_CaseAlts !(T_CaseAlts sem ) !(Inh_CaseAlts _lhsIoptions ) = + (let ( !_lhsOpps) = sem _lhsIoptions + in (Syn_CaseAlts _lhsOpps )) +sem_CaseAlts_Cons :: T_CaseAlt -> + T_CaseAlts -> + T_CaseAlts +sem_CaseAlts_Cons !(T_CaseAlt hd_ ) !(T_CaseAlts tl_ ) = + (T_CaseAlts (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 165 "PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOoptions ) of + { ( !_tlIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 172 "PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOoptions ) of + { ( !_hdIpp) -> + (case (({-# LINE 64 "PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 179 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) })) ) +sem_CaseAlts_Nil :: T_CaseAlts +sem_CaseAlts_Nil = + (T_CaseAlts (\ (!_lhsIoptions) -> + (case (({-# LINE 65 "PrintOcamlCode.ag" #-} + [] + {-# LINE 188 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- Chunk ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isToplevel : Bool + options : Options + textBlockMap : Map BlockInfo PP_Doc + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Chunk: + child name : {String} + child comment : Decl + child info : Decls + child dataDef : Decls + child cataFun : Decls + child semDom : Decls + child semWrapper : Decls + child semFunctions : Decls + child semNames : {[String]} +-} +-- cata +sem_Chunk :: Chunk -> + T_Chunk +sem_Chunk !(Chunk _name _comment _info _dataDef _cataFun _semDom _semWrapper _semFunctions _semNames ) = + (sem_Chunk_Chunk _name (sem_Decl _comment ) (sem_Decls _info ) (sem_Decls _dataDef ) (sem_Decls _cataFun ) (sem_Decls _semDom ) (sem_Decls _semWrapper ) (sem_Decls _semFunctions ) _semNames ) +-- semantic domain +newtype T_Chunk = T_Chunk (Bool -> + Options -> + (Map BlockInfo PP_Doc) -> + ( PP_Docs)) +data Inh_Chunk = Inh_Chunk {isToplevel_Inh_Chunk :: !(Bool),options_Inh_Chunk :: !(Options),textBlockMap_Inh_Chunk :: !((Map BlockInfo PP_Doc))} +data Syn_Chunk = Syn_Chunk {pps_Syn_Chunk :: !(PP_Docs)} +wrap_Chunk :: T_Chunk -> + Inh_Chunk -> + Syn_Chunk +wrap_Chunk !(T_Chunk sem ) !(Inh_Chunk _lhsIisToplevel _lhsIoptions _lhsItextBlockMap ) = + (let ( !_lhsOpps) = sem _lhsIisToplevel _lhsIoptions _lhsItextBlockMap + in (Syn_Chunk _lhsOpps )) +sem_Chunk_Chunk :: String -> + T_Decl -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + ([String]) -> + T_Chunk +sem_Chunk_Chunk !name_ !(T_Decl comment_ ) !(T_Decls info_ ) !(T_Decls dataDef_ ) !(T_Decls cataFun_ ) !(T_Decls semDom_ ) !(T_Decls semWrapper_ ) !(T_Decls semFunctions_ ) !semNames_ = + (T_Chunk (\ (!_lhsIisToplevel) + (!_lhsIoptions) + (!_lhsItextBlockMap) -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 247 "PrintOcamlCode.hs" #-} + )) of + { !_semFunctionsOisToplevel -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 252 "PrintOcamlCode.hs" #-} + )) of + { !_semWrapperOisToplevel -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 257 "PrintOcamlCode.hs" #-} + )) of + { !_semDomOisToplevel -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 262 "PrintOcamlCode.hs" #-} + )) of + { !_cataFunOisToplevel -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 267 "PrintOcamlCode.hs" #-} + )) of + { !_dataDefOisToplevel -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 272 "PrintOcamlCode.hs" #-} + )) of + { !_infoOisToplevel -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 277 "PrintOcamlCode.hs" #-} + )) of + { !_commentOisToplevel -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 282 "PrintOcamlCode.hs" #-} + )) of + { !_semFunctionsOoptions -> + (case (semFunctions_ _semFunctionsOisToplevel _semFunctionsOoptions ) of + { ( !_semFunctionsIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 289 "PrintOcamlCode.hs" #-} + )) of + { !_semWrapperOoptions -> + (case (semWrapper_ _semWrapperOisToplevel _semWrapperOoptions ) of + { ( !_semWrapperIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 296 "PrintOcamlCode.hs" #-} + )) of + { !_semDomOoptions -> + (case (semDom_ _semDomOisToplevel _semDomOoptions ) of + { ( !_semDomIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 303 "PrintOcamlCode.hs" #-} + )) of + { !_cataFunOoptions -> + (case (cataFun_ _cataFunOisToplevel _cataFunOoptions ) of + { ( !_cataFunIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 310 "PrintOcamlCode.hs" #-} + )) of + { !_dataDefOoptions -> + (case (dataDef_ _dataDefOisToplevel _dataDefOoptions ) of + { ( !_dataDefIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 317 "PrintOcamlCode.hs" #-} + )) of + { !_infoOoptions -> + (case (info_ _infoOisToplevel _infoOoptions ) of + { ( !_infoIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 324 "PrintOcamlCode.hs" #-} + )) of + { !_commentOoptions -> + (case (comment_ _commentOisToplevel _commentOoptions ) of + { ( !_commentIpp) -> + (case (({-# LINE 96 "PrintOcamlCode.ag" #-} + _commentIpp + : _infoIpps + ++ _dataDefIpps + ++ _semDomIpps + ++ _semFunctionsIpps + ++ _semWrapperIpps + ++ _cataFunIpps + ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] + {-# LINE 338 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Chunks ------------------------------------------------------ +{- + visit 0: + inherited attributes: + isToplevel : Bool + options : Options + textBlockMap : Map BlockInfo PP_Doc + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Chunk + child tl : Chunks + alternative Nil: +-} +-- cata +sem_Chunks :: Chunks -> + T_Chunks +sem_Chunks !list = + (Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list) ) +-- semantic domain +newtype T_Chunks = T_Chunks (Bool -> + Options -> + (Map BlockInfo PP_Doc) -> + ( PP_Docs)) +data Inh_Chunks = Inh_Chunks {isToplevel_Inh_Chunks :: !(Bool),options_Inh_Chunks :: !(Options),textBlockMap_Inh_Chunks :: !((Map BlockInfo PP_Doc))} +data Syn_Chunks = Syn_Chunks {pps_Syn_Chunks :: !(PP_Docs)} +wrap_Chunks :: T_Chunks -> + Inh_Chunks -> + Syn_Chunks +wrap_Chunks !(T_Chunks sem ) !(Inh_Chunks _lhsIisToplevel _lhsIoptions _lhsItextBlockMap ) = + (let ( !_lhsOpps) = sem _lhsIisToplevel _lhsIoptions _lhsItextBlockMap + in (Syn_Chunks _lhsOpps )) +sem_Chunks_Cons :: T_Chunk -> + T_Chunks -> + T_Chunks +sem_Chunks_Cons !(T_Chunk hd_ ) !(T_Chunks tl_ ) = + (T_Chunks (\ (!_lhsIisToplevel) + (!_lhsIoptions) + (!_lhsItextBlockMap) -> + (case (({-# LINE 45 "PrintOcamlCode.ag" #-} + _lhsItextBlockMap + {-# LINE 384 "PrintOcamlCode.hs" #-} + )) of + { !_tlOtextBlockMap -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 389 "PrintOcamlCode.hs" #-} + )) of + { !_tlOisToplevel -> + (case (({-# LINE 45 "PrintOcamlCode.ag" #-} + _lhsItextBlockMap + {-# LINE 394 "PrintOcamlCode.hs" #-} + )) of + { !_hdOtextBlockMap -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 399 "PrintOcamlCode.hs" #-} + )) of + { !_hdOisToplevel -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 404 "PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOisToplevel _tlOoptions _tlOtextBlockMap ) of + { ( !_tlIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 411 "PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOisToplevel _hdOoptions _hdOtextBlockMap ) of + { ( !_hdIpps) -> + (case (({-# LINE 84 "PrintOcamlCode.ag" #-} + _hdIpps ++ _tlIpps + {-# LINE 418 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) })) ) +sem_Chunks_Nil :: T_Chunks +sem_Chunks_Nil = + (T_Chunks (\ (!_lhsIisToplevel) + (!_lhsIoptions) + (!_lhsItextBlockMap) -> + (case (({-# LINE 85 "PrintOcamlCode.ag" #-} + [] + {-# LINE 429 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- DataAlt ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative DataAlt: + child name : {String} + child args : Types + alternative Record: + child name : {String} + child args : NamedTypes +-} +-- cata +sem_DataAlt :: DataAlt -> + T_DataAlt +sem_DataAlt !(DataAlt _name _args ) = + (sem_DataAlt_DataAlt _name (sem_Types _args ) ) +sem_DataAlt !(Record _name _args ) = + (sem_DataAlt_Record _name (sem_NamedTypes _args ) ) +-- semantic domain +newtype T_DataAlt = T_DataAlt (( PP_Doc)) +data Inh_DataAlt = Inh_DataAlt {} +data Syn_DataAlt = Syn_DataAlt {pp_Syn_DataAlt :: !(PP_Doc)} +wrap_DataAlt :: T_DataAlt -> + Inh_DataAlt -> + Syn_DataAlt +wrap_DataAlt !(T_DataAlt sem ) !(Inh_DataAlt ) = + (let ( !_lhsOpp) = sem + in (Syn_DataAlt _lhsOpp )) +sem_DataAlt_DataAlt :: String -> + T_Types -> + T_DataAlt +sem_DataAlt_DataAlt !name_ !(T_Types args_ ) = + (T_DataAlt (case (args_ ) of + { ( !_argsIpps) -> + (case (({-# LINE 183 "PrintOcamlCode.ag" #-} + name_ >#< "of" >#< pp_block "" "" " * " (map pp_parens _argsIpps) + {-# LINE 471 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) ) +sem_DataAlt_Record :: String -> + T_NamedTypes -> + T_DataAlt +sem_DataAlt_Record !name_ !(T_NamedTypes args_ ) = + (T_DataAlt (case (args_ ) of + { ( !_argsIpps) -> + (case (({-# LINE 184 "PrintOcamlCode.ag" #-} + pp_block "{" "}" ";" _argsIpps + {-# LINE 483 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) ) +-- DataAlts ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : DataAlt + child tl : DataAlts + alternative Nil: +-} +-- cata +sem_DataAlts :: DataAlts -> + T_DataAlts +sem_DataAlts !list = + (Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list) ) +-- semantic domain +newtype T_DataAlts = T_DataAlts (( PP_Docs)) +data Inh_DataAlts = Inh_DataAlts {} +data Syn_DataAlts = Syn_DataAlts {pps_Syn_DataAlts :: !(PP_Docs)} +wrap_DataAlts :: T_DataAlts -> + Inh_DataAlts -> + Syn_DataAlts +wrap_DataAlts !(T_DataAlts sem ) !(Inh_DataAlts ) = + (let ( !_lhsOpps) = sem + in (Syn_DataAlts _lhsOpps )) +sem_DataAlts_Cons :: T_DataAlt -> + T_DataAlts -> + T_DataAlts +sem_DataAlts_Cons !(T_DataAlt hd_ ) !(T_DataAlts tl_ ) = + (T_DataAlts (case (tl_ ) of + { ( !_tlIpps) -> + (case (hd_ ) of + { ( !_hdIpp) -> + (case (({-# LINE 68 "PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 523 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) ) +sem_DataAlts_Nil :: T_DataAlts +sem_DataAlts_Nil = + (T_DataAlts (case (({-# LINE 69 "PrintOcamlCode.ag" #-} + [] + {-# LINE 531 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) ) +-- Decl -------------------------------------------------------- +{- + visit 0: + inherited attributes: + isToplevel : Bool + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Bind: + child left : Lhs + child rhs : Expr + alternative BindLet: + child left : Lhs + child rhs : Expr + alternative Comment: + child txt : {String} + alternative Data: + child name : {String} + child params : {[String]} + child alts : DataAlts + child strict : {Bool} + child derivings : {[String]} + alternative Decl: + child left : Lhs + child rhs : Expr + child binds : {Set String} + child uses : {Set String} + alternative EvalDecl: + child nt : {String} + child left : Lhs + child rhs : Expr + alternative NewType: + child name : {String} + child params : {[String]} + child con : {String} + child tp : Type + alternative PragmaDecl: + child txt : {String} + alternative Resume: + child monadic : {Bool} + child nt : {String} + child left : Lhs + child rhs : Expr + alternative TSig: + child name : {String} + child tp : Type + alternative Type: + child name : {String} + child params : {[String]} + child tp : Type +-} +-- cata +sem_Decl :: Decl -> + T_Decl +sem_Decl !(Bind _left _rhs ) = + (sem_Decl_Bind (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Decl !(BindLet _left _rhs ) = + (sem_Decl_BindLet (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Decl !(Comment _txt ) = + (sem_Decl_Comment _txt ) +sem_Decl !(Data _name _params _alts _strict _derivings ) = + (sem_Decl_Data _name _params (sem_DataAlts _alts ) _strict _derivings ) +sem_Decl !(Decl _left _rhs _binds _uses ) = + (sem_Decl_Decl (sem_Lhs _left ) (sem_Expr _rhs ) _binds _uses ) +sem_Decl !(EvalDecl _nt _left _rhs ) = + (sem_Decl_EvalDecl _nt (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Decl !(NewType _name _params _con _tp ) = + (sem_Decl_NewType _name _params _con (sem_Type _tp ) ) +sem_Decl !(PragmaDecl _txt ) = + (sem_Decl_PragmaDecl _txt ) +sem_Decl !(Resume _monadic _nt _left _rhs ) = + (sem_Decl_Resume _monadic _nt (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Decl !(TSig _name _tp ) = + (sem_Decl_TSig _name (sem_Type _tp ) ) +sem_Decl !(Type _name _params _tp ) = + (sem_Decl_Type _name _params (sem_Type _tp ) ) +-- semantic domain +newtype T_Decl = T_Decl (Bool -> + Options -> + ( PP_Doc)) +data Inh_Decl = Inh_Decl {isToplevel_Inh_Decl :: !(Bool),options_Inh_Decl :: !(Options)} +data Syn_Decl = Syn_Decl {pp_Syn_Decl :: !(PP_Doc)} +wrap_Decl :: T_Decl -> + Inh_Decl -> + Syn_Decl +wrap_Decl !(T_Decl sem ) !(Inh_Decl _lhsIisToplevel _lhsIoptions ) = + (let ( !_lhsOpp) = sem _lhsIisToplevel _lhsIoptions + in (Syn_Decl _lhsOpp )) +sem_Decl_Bind :: T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_Bind !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 111 "PrintOcamlCode.ag" #-} + error "pp of Decl.Bind not supported" + {-# LINE 632 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Decl_BindLet :: T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_BindLet !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 112 "PrintOcamlCode.ag" #-} + error "pp of Decl.BindLet not supported" + {-# LINE 644 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Decl_Comment :: String -> + T_Decl +sem_Decl_Comment !txt_ = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 123 "PrintOcamlCode.ag" #-} + if '\n' `elem` txt_ + then "(* " >-< vlist (lines txt_) >-< "*)" + else "(*" >#< txt_ >#< "*)" + {-# LINE 657 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Decl_Data :: String -> + ([String]) -> + T_DataAlts -> + Bool -> + ([String]) -> + T_Decl +sem_Decl_Data !name_ !params_ !(T_DataAlts alts_ ) !strict_ !derivings_ = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (alts_ ) of + { ( !_altsIpps) -> + (case (({-# LINE 113 "PrintOcamlCode.ag" #-} + "type" >#< hv_sp (map (\p -> "'" >|< p) params_ ++ [text $ toOcamlTC name_]) + >#< ( case _altsIpps of + [] -> empty + (x:xs) -> "=" >#< x + >-< vlist (map ("|" >#<) xs) + ) + >#< ";;" + {-# LINE 680 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) ) +sem_Decl_Decl :: T_Lhs -> + T_Expr -> + (Set String) -> + (Set String) -> + T_Decl +sem_Decl_Decl !(T_Lhs left_ ) !(T_Expr rhs_ ) !binds_ !uses_ = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 694 "PrintOcamlCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (rhs_ _rhsOoptions ) of + { ( !_rhsIpp) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 701 "PrintOcamlCode.hs" #-} + )) of + { !_leftOoptions -> + (case (left_ _leftOoptions ) of + { ( !_leftIpp) -> + (case (({-# LINE 106 "PrintOcamlCode.ag" #-} + if _lhsIisToplevel + then "let" >#< _leftIpp >#< "=" + >-< indent 4 _rhsIpp >#< ";;" + else "let" >#< _leftIpp >#< "=" + >-< indent 4 _rhsIpp >#< "in" + {-# LINE 712 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Decl_EvalDecl :: String -> + T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_EvalDecl !nt_ !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 725 "PrintOcamlCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (rhs_ _rhsOoptions ) of + { ( !_rhsIpp) -> + (case (({-# LINE 53 "PrintOcamlCode.ag" #-} + _rhsIpp + {-# LINE 732 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Decl_NewType :: String -> + ([String]) -> + String -> + T_Type -> + T_Decl +sem_Decl_NewType !name_ !params_ !con_ !(T_Type tp_ ) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 120 "PrintOcamlCode.ag" #-} + error "pp of Decl.NewType not supported" + {-# LINE 746 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Decl_PragmaDecl :: String -> + T_Decl +sem_Decl_PragmaDecl !txt_ = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 126 "PrintOcamlCode.ag" #-} + error "pp of Decl.PragmaDecl not supported" + {-# LINE 757 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Decl_Resume :: Bool -> + String -> + T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_Resume !monadic_ !nt_ !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 771 "PrintOcamlCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (rhs_ _rhsOoptions ) of + { ( !_rhsIpp) -> + (case (({-# LINE 53 "PrintOcamlCode.ag" #-} + _rhsIpp + {-# LINE 778 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Decl_TSig :: String -> + T_Type -> + T_Decl +sem_Decl_TSig !name_ !(T_Type tp_ ) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (tp_ ) of + { ( !_tpIpp) -> + (case (({-# LINE 122 "PrintOcamlCode.ag" #-} + "(*" >#< name_ >#< ":" >#< _tpIpp >#< "*)" + {-# LINE 792 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) ) +sem_Decl_Type :: String -> + ([String]) -> + T_Type -> + T_Decl +sem_Decl_Type !name_ !params_ !(T_Type tp_ ) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (tp_ ) of + { ( !_tpIpp) -> + (case (({-# LINE 121 "PrintOcamlCode.ag" #-} + "type" >#< hv_sp (map (\p -> "'" >|< p) params_ ++ [text $ toOcamlTC name_]) >#< "=" >#< _tpIpp >#< ";;" + {-# LINE 807 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) ) +-- Decls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isToplevel : Bool + options : Options + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Decl + child tl : Decls + alternative Nil: +-} +-- cata +sem_Decls :: Decls -> + T_Decls +sem_Decls !list = + (Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list) ) +-- semantic domain +newtype T_Decls = T_Decls (Bool -> + Options -> + ( PP_Docs)) +data Inh_Decls = Inh_Decls {isToplevel_Inh_Decls :: !(Bool),options_Inh_Decls :: !(Options)} +data Syn_Decls = Syn_Decls {pps_Syn_Decls :: !(PP_Docs)} +wrap_Decls :: T_Decls -> + Inh_Decls -> + Syn_Decls +wrap_Decls !(T_Decls sem ) !(Inh_Decls _lhsIisToplevel _lhsIoptions ) = + (let ( !_lhsOpps) = sem _lhsIisToplevel _lhsIoptions + in (Syn_Decls _lhsOpps )) +sem_Decls_Cons :: T_Decl -> + T_Decls -> + T_Decls +sem_Decls_Cons !(T_Decl hd_ ) !(T_Decls tl_ ) = + (T_Decls (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 850 "PrintOcamlCode.hs" #-} + )) of + { !_tlOisToplevel -> + (case (({-# LINE 209 "PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 855 "PrintOcamlCode.hs" #-} + )) of + { !_hdOisToplevel -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 860 "PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOisToplevel _tlOoptions ) of + { ( !_tlIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 867 "PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOisToplevel _hdOoptions ) of + { ( !_hdIpp) -> + (case (({-# LINE 80 "PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 874 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) })) ) +sem_Decls_Nil :: T_Decls +sem_Decls_Nil = + (T_Decls (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 81 "PrintOcamlCode.ag" #-} + [] + {-# LINE 884 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- Expr -------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative App: + child name : {String} + child args : Exprs + alternative Case: + child expr : Expr + child alts : CaseAlts + alternative Do: + child stmts : Decls + child body : Expr + alternative InvokeExpr: + child nt : {String} + child expr : Expr + child args : Exprs + alternative Lambda: + child args : Exprs + child body : Expr + alternative Let: + child decls : Decls + child body : Expr + alternative LineExpr: + child expr : Expr + alternative PragmaExpr: + child onLeftSide : {Bool} + child onNewLine : {Bool} + child txt : {String} + child expr : Expr + alternative ResultExpr: + child nt : {String} + child expr : Expr + alternative ResumeExpr: + child nt : {String} + child expr : Expr + child left : Lhs + child rhs : Expr + alternative SemFun: + child nt : {String} + child args : Exprs + child body : Expr + alternative SimpleExpr: + child txt : {String} + alternative TextExpr: + child lns : {[String]} + alternative Trace: + child txt : {String} + child expr : Expr + alternative TupleExpr: + child exprs : Exprs + alternative TypedExpr: + child expr : Expr + child tp : Type + alternative UnboxedTupleExpr: + child exprs : Exprs +-} +-- cata +sem_Expr :: Expr -> + T_Expr +sem_Expr !(App _name _args ) = + (sem_Expr_App _name (sem_Exprs _args ) ) +sem_Expr !(Case _expr _alts ) = + (sem_Expr_Case (sem_Expr _expr ) (sem_CaseAlts _alts ) ) +sem_Expr !(Do _stmts _body ) = + (sem_Expr_Do (sem_Decls _stmts ) (sem_Expr _body ) ) +sem_Expr !(InvokeExpr _nt _expr _args ) = + (sem_Expr_InvokeExpr _nt (sem_Expr _expr ) (sem_Exprs _args ) ) +sem_Expr !(Lambda _args _body ) = + (sem_Expr_Lambda (sem_Exprs _args ) (sem_Expr _body ) ) +sem_Expr !(Let _decls _body ) = + (sem_Expr_Let (sem_Decls _decls ) (sem_Expr _body ) ) +sem_Expr !(LineExpr _expr ) = + (sem_Expr_LineExpr (sem_Expr _expr ) ) +sem_Expr !(PragmaExpr _onLeftSide _onNewLine _txt _expr ) = + (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr ) ) +sem_Expr !(ResultExpr _nt _expr ) = + (sem_Expr_ResultExpr _nt (sem_Expr _expr ) ) +sem_Expr !(ResumeExpr _nt _expr _left _rhs ) = + (sem_Expr_ResumeExpr _nt (sem_Expr _expr ) (sem_Lhs _left ) (sem_Expr _rhs ) ) +sem_Expr !(SemFun _nt _args _body ) = + (sem_Expr_SemFun _nt (sem_Exprs _args ) (sem_Expr _body ) ) +sem_Expr !(SimpleExpr _txt ) = + (sem_Expr_SimpleExpr _txt ) +sem_Expr !(TextExpr _lns ) = + (sem_Expr_TextExpr _lns ) +sem_Expr !(Trace _txt _expr ) = + (sem_Expr_Trace _txt (sem_Expr _expr ) ) +sem_Expr !(TupleExpr _exprs ) = + (sem_Expr_TupleExpr (sem_Exprs _exprs ) ) +sem_Expr !(TypedExpr _expr _tp ) = + (sem_Expr_TypedExpr (sem_Expr _expr ) (sem_Type _tp ) ) +sem_Expr !(UnboxedTupleExpr _exprs ) = + (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs ) ) +-- semantic domain +newtype T_Expr = T_Expr (Options -> + ( PP_Doc)) +data Inh_Expr = Inh_Expr {options_Inh_Expr :: !(Options)} +data Syn_Expr = Syn_Expr {pp_Syn_Expr :: !(PP_Doc)} +wrap_Expr :: T_Expr -> + Inh_Expr -> + Syn_Expr +wrap_Expr !(T_Expr sem ) !(Inh_Expr _lhsIoptions ) = + (let ( !_lhsOpp) = sem _lhsIoptions + in (Syn_Expr _lhsOpp )) +sem_Expr_App :: String -> + T_Exprs -> + T_Expr +sem_Expr_App !name_ !(T_Exprs args_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1004 "PrintOcamlCode.hs" #-} + )) of + { !_argsOoptions -> + (case (args_ _argsOoptions ) of + { ( !_argsIpps) -> + (case (({-# LINE 143 "PrintOcamlCode.ag" #-} + pp_parens $ name_ >#< hv_sp _argsIpps + {-# LINE 1011 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_Case :: T_Expr -> + T_CaseAlts -> + T_Expr +sem_Expr_Case !(T_Expr expr_ ) !(T_CaseAlts alts_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1022 "PrintOcamlCode.hs" #-} + )) of + { !_altsOoptions -> + (case (alts_ _altsOoptions ) of + { ( !_altsIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1029 "PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions ) of + { ( !_exprIpp) -> + (case (({-# LINE 131 "PrintOcamlCode.ag" #-} + pp_parens ( "match" >#< _exprIpp >#< "with" + >-< indent 2 ( case _altsIpps of + [] -> empty + (x:xs) -> " " >#< x + >-< vlist (map ("|" >#<) xs) + ) + ) + {-# LINE 1042 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Expr_Do :: T_Decls -> + T_Expr -> + T_Expr +sem_Expr_Do !(T_Decls stmts_ ) !(T_Expr body_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 138 "PrintOcamlCode.ag" #-} + error "pp of Expr.Do not supported" + {-# LINE 1053 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Expr_InvokeExpr :: String -> + T_Expr -> + T_Exprs -> + T_Expr +sem_Expr_InvokeExpr !nt_ !(T_Expr expr_ ) !(T_Exprs args_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1065 "PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions ) of + { ( !_exprIpp) -> + (case (({-# LINE 53 "PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1072 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_Lambda :: T_Exprs -> + T_Expr -> + T_Expr +sem_Expr_Lambda !(T_Exprs args_ ) !(T_Expr body_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1083 "PrintOcamlCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (body_ _bodyOoptions ) of + { ( !_bodyIpp) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1090 "PrintOcamlCode.hs" #-} + )) of + { !_argsOoptions -> + (case (args_ _argsOoptions ) of + { ( !_argsIpps) -> + (case (({-# LINE 139 "PrintOcamlCode.ag" #-} + pp_parens ( pp "fun" >#< hv_sp _argsIpps >#< "->" + >-< indent 2 _bodyIpp ) + {-# LINE 1098 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) })) ) +sem_Expr_Let :: T_Decls -> + T_Expr -> + T_Expr +sem_Expr_Let !(T_Decls decls_ ) !(T_Expr body_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 216 "PrintOcamlCode.ag" #-} + False + {-# LINE 1109 "PrintOcamlCode.hs" #-} + )) of + { !_declsOisToplevel -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1114 "PrintOcamlCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (body_ _bodyOoptions ) of + { ( !_bodyIpp) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1121 "PrintOcamlCode.hs" #-} + )) of + { !_declsOoptions -> + (case (decls_ _declsOisToplevel _declsOoptions ) of + { ( !_declsIpps) -> + (case (({-# LINE 130 "PrintOcamlCode.ag" #-} + pp_parens $ vlist (_declsIpps ++ [_bodyIpp]) + {-# LINE 1128 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) })) ) +sem_Expr_LineExpr :: T_Expr -> + T_Expr +sem_Expr_LineExpr !(T_Expr expr_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1138 "PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions ) of + { ( !_exprIpp) -> + (case (({-# LINE 148 "PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1145 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_PragmaExpr :: Bool -> + Bool -> + String -> + T_Expr -> + T_Expr +sem_Expr_PragmaExpr !onLeftSide_ !onNewLine_ !txt_ !(T_Expr expr_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1158 "PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions ) of + { ( !_exprIpp) -> + (case (({-# LINE 147 "PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1165 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_ResultExpr :: String -> + T_Expr -> + T_Expr +sem_Expr_ResultExpr !nt_ !(T_Expr expr_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1176 "PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions ) of + { ( !_exprIpp) -> + (case (({-# LINE 53 "PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1183 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_ResumeExpr :: String -> + T_Expr -> + T_Lhs -> + T_Expr -> + T_Expr +sem_Expr_ResumeExpr !nt_ !(T_Expr expr_ ) !(T_Lhs left_ ) !(T_Expr rhs_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1196 "PrintOcamlCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (rhs_ _rhsOoptions ) of + { ( !_rhsIpp) -> + (case (({-# LINE 53 "PrintOcamlCode.ag" #-} + _rhsIpp + {-# LINE 1203 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_SemFun :: String -> + T_Exprs -> + T_Expr -> + T_Expr +sem_Expr_SemFun !nt_ !(T_Exprs args_ ) !(T_Expr body_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1215 "PrintOcamlCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (body_ _bodyOoptions ) of + { ( !_bodyIpp) -> + (case (({-# LINE 53 "PrintOcamlCode.ag" #-} + _bodyIpp + {-# LINE 1222 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_SimpleExpr :: String -> + T_Expr +sem_Expr_SimpleExpr !txt_ = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 144 "PrintOcamlCode.ag" #-} + text txt_ + {-# LINE 1232 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Expr_TextExpr :: ([String]) -> + T_Expr +sem_Expr_TextExpr !lns_ = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 145 "PrintOcamlCode.ag" #-} + vlist (map text lns_) + {-# LINE 1242 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Expr_Trace :: String -> + T_Expr -> + T_Expr +sem_Expr_Trace !txt_ !(T_Expr expr_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1253 "PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions ) of + { ( !_exprIpp) -> + (case (({-# LINE 146 "PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1260 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_TupleExpr :: T_Exprs -> + T_Expr +sem_Expr_TupleExpr !(T_Exprs exprs_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1270 "PrintOcamlCode.hs" #-} + )) of + { !_exprsOoptions -> + (case (exprs_ _exprsOoptions ) of + { ( !_exprsIpps) -> + (case (({-# LINE 141 "PrintOcamlCode.ag" #-} + ppTuple False _exprsIpps + {-# LINE 1277 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_TypedExpr :: T_Expr -> + T_Type -> + T_Expr +sem_Expr_TypedExpr !(T_Expr expr_ ) !(T_Type tp_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1288 "PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions ) of + { ( !_exprIpp) -> + (case (({-# LINE 149 "PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1295 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Expr_UnboxedTupleExpr :: T_Exprs -> + T_Expr +sem_Expr_UnboxedTupleExpr !(T_Exprs exprs_ ) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 142 "PrintOcamlCode.ag" #-} + error "pp of Expr.UnboxedTupleExpr not supported" + {-# LINE 1305 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +-- Exprs ------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Expr + child tl : Exprs + alternative Nil: +-} +-- cata +sem_Exprs :: Exprs -> + T_Exprs +sem_Exprs !list = + (Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list) ) +-- semantic domain +newtype T_Exprs = T_Exprs (Options -> + ( PP_Docs)) +data Inh_Exprs = Inh_Exprs {options_Inh_Exprs :: !(Options)} +data Syn_Exprs = Syn_Exprs {pps_Syn_Exprs :: !(PP_Docs)} +wrap_Exprs :: T_Exprs -> + Inh_Exprs -> + Syn_Exprs +wrap_Exprs !(T_Exprs sem ) !(Inh_Exprs _lhsIoptions ) = + (let ( !_lhsOpps) = sem _lhsIoptions + in (Syn_Exprs _lhsOpps )) +sem_Exprs_Cons :: T_Expr -> + T_Exprs -> + T_Exprs +sem_Exprs_Cons !(T_Expr hd_ ) !(T_Exprs tl_ ) = + (T_Exprs (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1345 "PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOoptions ) of + { ( !_tlIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1352 "PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOoptions ) of + { ( !_hdIpp) -> + (case (({-# LINE 60 "PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 1359 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) })) ) +sem_Exprs_Nil :: T_Exprs +sem_Exprs_Nil = + (T_Exprs (\ (!_lhsIoptions) -> + (case (({-# LINE 61 "PrintOcamlCode.ag" #-} + [] + {-# LINE 1368 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) ) +-- Lhs --------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Fun: + child name : {String} + child args : Exprs + alternative Pattern3: + child pat3 : Pattern + alternative Pattern3SM: + child pat3 : Pattern + alternative TupleLhs: + child comps : {[String]} + alternative UnboxedTupleLhs: + child comps : {[String]} + alternative Unwrap: + child name : {String} + child sub : Lhs +-} +-- cata +sem_Lhs :: Lhs -> + T_Lhs +sem_Lhs !(Fun _name _args ) = + (sem_Lhs_Fun _name (sem_Exprs _args ) ) +sem_Lhs !(Pattern3 _pat3 ) = + (sem_Lhs_Pattern3 (sem_Pattern _pat3 ) ) +sem_Lhs !(Pattern3SM _pat3 ) = + (sem_Lhs_Pattern3SM (sem_Pattern _pat3 ) ) +sem_Lhs !(TupleLhs _comps ) = + (sem_Lhs_TupleLhs _comps ) +sem_Lhs !(UnboxedTupleLhs _comps ) = + (sem_Lhs_UnboxedTupleLhs _comps ) +sem_Lhs !(Unwrap _name _sub ) = + (sem_Lhs_Unwrap _name (sem_Lhs _sub ) ) +-- semantic domain +newtype T_Lhs = T_Lhs (Options -> + ( PP_Doc)) +data Inh_Lhs = Inh_Lhs {options_Inh_Lhs :: !(Options)} +data Syn_Lhs = Syn_Lhs {pp_Syn_Lhs :: !(PP_Doc)} +wrap_Lhs :: T_Lhs -> + Inh_Lhs -> + Syn_Lhs +wrap_Lhs !(T_Lhs sem ) !(Inh_Lhs _lhsIoptions ) = + (let ( !_lhsOpp) = sem _lhsIoptions + in (Syn_Lhs _lhsOpp )) +sem_Lhs_Fun :: String -> + T_Exprs -> + T_Lhs +sem_Lhs_Fun !name_ !(T_Exprs args_ ) = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1428 "PrintOcamlCode.hs" #-} + )) of + { !_argsOoptions -> + (case (args_ _argsOoptions ) of + { ( !_argsIpps) -> + (case (({-# LINE 156 "PrintOcamlCode.ag" #-} + name_ >#< hv_sp _argsIpps + {-# LINE 1435 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Lhs_Pattern3 :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3 !(T_Pattern pat3_ ) = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1445 "PrintOcamlCode.hs" #-} + )) of + { !_pat3Ooptions -> + (case (pat3_ _pat3Ooptions ) of + { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp) -> + (case (({-# LINE 152 "PrintOcamlCode.ag" #-} + _pat3Ipp + {-# LINE 1452 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +sem_Lhs_Pattern3SM :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3SM !(T_Pattern pat3_ ) = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 153 "PrintOcamlCode.ag" #-} + error "pp of Lhs.Pattern3SM not supported" + {-# LINE 1462 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Lhs_TupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_TupleLhs !comps_ = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 154 "PrintOcamlCode.ag" #-} + ppTuple False (map text comps_) + {-# LINE 1472 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Lhs_UnboxedTupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_UnboxedTupleLhs !comps_ = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 155 "PrintOcamlCode.ag" #-} + error "pp of Lhs.UnboxedTupleLhs not supported" + {-# LINE 1482 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) ) +sem_Lhs_Unwrap :: String -> + T_Lhs -> + T_Lhs +sem_Lhs_Unwrap !name_ !(T_Lhs sub_ ) = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1493 "PrintOcamlCode.hs" #-} + )) of + { !_subOoptions -> + (case (sub_ _subOoptions ) of + { ( !_subIpp) -> + (case (({-# LINE 157 "PrintOcamlCode.ag" #-} + pp_parens (name_ >#< _subIpp) + {-# LINE 1500 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) ) +-- NamedType --------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Named: + child strict : {Bool} + child name : {String} + child tp : Type +-} +-- cata +sem_NamedType :: NamedType -> + T_NamedType +sem_NamedType !(Named _strict _name _tp ) = + (sem_NamedType_Named _strict _name (sem_Type _tp ) ) +-- semantic domain +newtype T_NamedType = T_NamedType (( PP_Doc)) +data Inh_NamedType = Inh_NamedType {} +data Syn_NamedType = Syn_NamedType {pp_Syn_NamedType :: !(PP_Doc)} +wrap_NamedType :: T_NamedType -> + Inh_NamedType -> + Syn_NamedType +wrap_NamedType !(T_NamedType sem ) !(Inh_NamedType ) = + (let ( !_lhsOpp) = sem + in (Syn_NamedType _lhsOpp )) +sem_NamedType_Named :: Bool -> + String -> + T_Type -> + T_NamedType +sem_NamedType_Named !strict_ !name_ !(T_Type tp_ ) = + (T_NamedType (case (tp_ ) of + { ( !_tpIpp) -> + (case (({-# LINE 187 "PrintOcamlCode.ag" #-} + name_ >#< ":" >#< _tpIpp + {-# LINE 1539 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) ) +-- NamedTypes -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : NamedType + child tl : NamedTypes + alternative Nil: +-} +-- cata +sem_NamedTypes :: NamedTypes -> + T_NamedTypes +sem_NamedTypes !list = + (Prelude.foldr sem_NamedTypes_Cons sem_NamedTypes_Nil (Prelude.map sem_NamedType list) ) +-- semantic domain +newtype T_NamedTypes = T_NamedTypes (( PP_Docs)) +data Inh_NamedTypes = Inh_NamedTypes {} +data Syn_NamedTypes = Syn_NamedTypes {pps_Syn_NamedTypes :: !(PP_Docs)} +wrap_NamedTypes :: T_NamedTypes -> + Inh_NamedTypes -> + Syn_NamedTypes +wrap_NamedTypes !(T_NamedTypes sem ) !(Inh_NamedTypes ) = + (let ( !_lhsOpps) = sem + in (Syn_NamedTypes _lhsOpps )) +sem_NamedTypes_Cons :: T_NamedType -> + T_NamedTypes -> + T_NamedTypes +sem_NamedTypes_Cons !(T_NamedType hd_ ) !(T_NamedTypes tl_ ) = + (T_NamedTypes (case (tl_ ) of + { ( !_tlIpps) -> + (case (hd_ ) of + { ( !_hdIpp) -> + (case (({-# LINE 76 "PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 1579 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) ) +sem_NamedTypes_Nil :: T_NamedTypes +sem_NamedTypes_Nil = + (T_NamedTypes (case (({-# LINE 77 "PrintOcamlCode.ag" #-} + [] + {-# LINE 1587 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + copy : SELF + isUnderscore : Bool + pp : PP_Doc + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern !(Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern !(Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern !(Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern !(Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern !(Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (Options -> + ( Pattern ,Bool,PP_Doc)) +data Inh_Pattern = Inh_Pattern {options_Inh_Pattern :: !(Options)} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern ),isUnderscore_Syn_Pattern :: !(Bool),pp_Syn_Pattern :: !(PP_Doc)} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern !(T_Pattern sem ) !(Inh_Pattern _lhsIoptions ) = + (let ( !_lhsOcopy,!_lhsOisUnderscore,!_lhsOpp) = sem _lhsIoptions + in (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1660 "PrintOcamlCode.hs" #-} + )) of + { !_partsOoptions -> + (case (parts_ _partsOoptions ) of + { ( !_partsIcopy,!_partsIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1667 "PrintOcamlCode.hs" #-} + )) of + { !_patOoptions -> + (case (pat_ _patOoptions ) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 1674 "PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1679 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 202 "PrintOcamlCode.ag" #-} + False + {-# LINE 1684 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 193 "PrintOcamlCode.ag" #-} + if _patIisUnderscore + then pp (attrname False field_ attr_) + else error "pp of Pattern.Alias is only supported in the form (x@_)" + {-# LINE 1691 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) }) }) })) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_ ) = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1702 "PrintOcamlCode.hs" #-} + )) of + { !_patsOoptions -> + (case (pats_ _patsOoptions ) of + { ( !_patsIcopy,!_patsIpps) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1709 "PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1714 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 200 "PrintOcamlCode.ag" #-} + False + {-# LINE 1719 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 190 "PrintOcamlCode.ag" #-} + pp_parens $ name_ >#< hv_sp _patsIpps + {-# LINE 1724 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) })) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_ ) = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1734 "PrintOcamlCode.hs" #-} + )) of + { !_patOoptions -> + (case (pat_ _patOoptions ) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1741 "PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1746 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 199 "PrintOcamlCode.ag" #-} + _patIisUnderscore + {-# LINE 1751 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 196 "PrintOcamlCode.ag" #-} + error "pp of Pattern.Irrefutable not supported" + {-# LINE 1756 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) })) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_ ) = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1767 "PrintOcamlCode.hs" #-} + )) of + { !_patsOoptions -> + (case (pats_ _patsOoptions ) of + { ( !_patsIcopy,!_patsIpps) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1774 "PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1779 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 201 "PrintOcamlCode.ag" #-} + False + {-# LINE 1784 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 191 "PrintOcamlCode.ag" #-} + pp_block "(" ")" "," _patsIpps + {-# LINE 1789 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) })) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 1799 "PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1804 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 203 "PrintOcamlCode.ag" #-} + True + {-# LINE 1809 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 197 "PrintOcamlCode.ag" #-} + text "_" + {-# LINE 1814 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) })) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + copy : SELF + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (Options -> + ( Patterns ,PP_Docs)) +data Inh_Patterns = Inh_Patterns {options_Inh_Patterns :: !(Options)} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns ),pps_Syn_Patterns :: !(PP_Docs)} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns !(T_Patterns sem ) !(Inh_Patterns _lhsIoptions ) = + (let ( !_lhsOcopy,!_lhsOpps) = sem _lhsIoptions + in (Syn_Patterns _lhsOcopy _lhsOpps )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons !(T_Pattern hd_ ) !(T_Patterns tl_ ) = + (T_Patterns (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1859 "PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOoptions ) of + { ( !_tlIcopy,!_tlIpps) -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1866 "PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOoptions ) of + { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1873 "PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1878 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 88 "PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 1883 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOcopy,_lhsOpps) }) }) }) }) }) }) })) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIoptions) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 1892 "PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1897 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 89 "PrintOcamlCode.ag" #-} + [] + {-# LINE 1902 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOcopy,_lhsOpps) }) }) })) ) +-- Program ----------------------------------------------------- +{- + visit 0: + inherited attributes: + options : Options + textBlockMap : Map BlockInfo PP_Doc + synthesized attribute: + output : PP_Docs + alternatives: + alternative Program: + child chunks : Chunks + child ordered : {Bool} +-} +-- cata +sem_Program :: Program -> + T_Program +sem_Program !(Program _chunks _ordered ) = + (sem_Program_Program (sem_Chunks _chunks ) _ordered ) +-- semantic domain +newtype T_Program = T_Program (Options -> + (Map BlockInfo PP_Doc) -> + ( PP_Docs)) +data Inh_Program = Inh_Program {options_Inh_Program :: !(Options),textBlockMap_Inh_Program :: !((Map BlockInfo PP_Doc))} +data Syn_Program = Syn_Program {output_Syn_Program :: !(PP_Docs)} +wrap_Program :: T_Program -> + Inh_Program -> + Syn_Program +wrap_Program !(T_Program sem ) !(Inh_Program _lhsIoptions _lhsItextBlockMap ) = + (let ( !_lhsOoutput) = sem _lhsIoptions _lhsItextBlockMap + in (Syn_Program _lhsOoutput )) +sem_Program_Program :: T_Chunks -> + Bool -> + T_Program +sem_Program_Program !(T_Chunks chunks_ ) !ordered_ = + (T_Program (\ (!_lhsIoptions) + (!_lhsItextBlockMap) -> + (case (({-# LINE 45 "PrintOcamlCode.ag" #-} + _lhsItextBlockMap + {-# LINE 1944 "PrintOcamlCode.hs" #-} + )) of + { !_chunksOtextBlockMap -> + (case (({-# LINE 212 "PrintOcamlCode.ag" #-} + True + {-# LINE 1949 "PrintOcamlCode.hs" #-} + )) of + { !_chunksOisToplevel -> + (case (({-# LINE 43 "PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1954 "PrintOcamlCode.hs" #-} + )) of + { !_chunksOoptions -> + (case (chunks_ _chunksOisToplevel _chunksOoptions _chunksOtextBlockMap ) of + { ( !_chunksIpps) -> + (case (({-# LINE 57 "PrintOcamlCode.ag" #-} + _chunksIpps + {-# LINE 1961 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) }) })) ) +-- Type -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Arr: + child left : Type + child right : Type + alternative CtxApp: + child left : {[(String, [String])]} + child right : Type + alternative List: + child tp : Type + alternative NontermType: + child name : {String} + child params : {[String]} + alternative QuantApp: + child left : {String} + child right : Type + alternative SimpleType: + child txt : {String} + alternative TEither: + child left : Type + child right : Type + alternative TIntMap: + child value : Type + alternative TMap: + child key : Type + child value : Type + alternative TMaybe: + child tp : Type + alternative TupleType: + child tps : Types + alternative TypeApp: + child func : Type + child args : Types + alternative UnboxedTupleType: + child tps : Types +-} +-- cata +sem_Type :: Type -> + T_Type +sem_Type !(Arr _left _right ) = + (sem_Type_Arr (sem_Type _left ) (sem_Type _right ) ) +sem_Type !(CtxApp _left _right ) = + (sem_Type_CtxApp _left (sem_Type _right ) ) +sem_Type !(List _tp ) = + (sem_Type_List (sem_Type _tp ) ) +sem_Type !(NontermType _name _params ) = + (sem_Type_NontermType _name _params ) +sem_Type !(QuantApp _left _right ) = + (sem_Type_QuantApp _left (sem_Type _right ) ) +sem_Type !(SimpleType _txt ) = + (sem_Type_SimpleType _txt ) +sem_Type !(TEither _left _right ) = + (sem_Type_TEither (sem_Type _left ) (sem_Type _right ) ) +sem_Type !(TIntMap _value ) = + (sem_Type_TIntMap (sem_Type _value ) ) +sem_Type !(TMap _key _value ) = + (sem_Type_TMap (sem_Type _key ) (sem_Type _value ) ) +sem_Type !(TMaybe _tp ) = + (sem_Type_TMaybe (sem_Type _tp ) ) +sem_Type !(TupleType _tps ) = + (sem_Type_TupleType (sem_Types _tps ) ) +sem_Type !(TypeApp _func _args ) = + (sem_Type_TypeApp (sem_Type _func ) (sem_Types _args ) ) +sem_Type !(UnboxedTupleType _tps ) = + (sem_Type_UnboxedTupleType (sem_Types _tps ) ) +-- semantic domain +newtype T_Type = T_Type (( PP_Doc)) +data Inh_Type = Inh_Type {} +data Syn_Type = Syn_Type {pp_Syn_Type :: !(PP_Doc)} +wrap_Type :: T_Type -> + Inh_Type -> + Syn_Type +wrap_Type !(T_Type sem ) !(Inh_Type ) = + (let ( !_lhsOpp) = sem + in (Syn_Type _lhsOpp )) +sem_Type_Arr :: T_Type -> + T_Type -> + T_Type +sem_Type_Arr !(T_Type left_ ) !(T_Type right_ ) = + (T_Type (case (right_ ) of + { ( !_rightIpp) -> + (case (left_ ) of + { ( !_leftIpp) -> + (case (({-# LINE 160 "PrintOcamlCode.ag" #-} + pp_parens (_leftIpp >#< "->" >#< _rightIpp) + {-# LINE 2054 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) ) +sem_Type_CtxApp :: ([(String, [String])]) -> + T_Type -> + T_Type +sem_Type_CtxApp !left_ !(T_Type right_ ) = + (T_Type (case (({-# LINE 161 "PrintOcamlCode.ag" #-} + error "pp of Type.CtxApp not supported" + {-# LINE 2064 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) ) +sem_Type_List :: T_Type -> + T_Type +sem_Type_List !(T_Type tp_ ) = + (T_Type (case (tp_ ) of + { ( !_tpIpp) -> + (case (({-# LINE 166 "PrintOcamlCode.ag" #-} + _tpIpp >#< "list" + {-# LINE 2075 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) ) +sem_Type_NontermType :: String -> + ([String]) -> + T_Type +sem_Type_NontermType !name_ !params_ = + (T_Type (case (({-# LINE 168 "PrintOcamlCode.ag" #-} + pp_block "(" ")" " " (map text params_ ++ [text $ toOcamlTC name_]) + {-# LINE 2085 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) ) +sem_Type_QuantApp :: String -> + T_Type -> + T_Type +sem_Type_QuantApp !left_ !(T_Type right_ ) = + (T_Type (case (right_ ) of + { ( !_rightIpp) -> + (case (({-# LINE 53 "PrintOcamlCode.ag" #-} + _rightIpp + {-# LINE 2097 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) ) +sem_Type_SimpleType :: String -> + T_Type +sem_Type_SimpleType !txt_ = + (T_Type (case (({-# LINE 167 "PrintOcamlCode.ag" #-} + text txt_ + {-# LINE 2106 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) ) +sem_Type_TEither :: T_Type -> + T_Type -> + T_Type +sem_Type_TEither !(T_Type left_ ) !(T_Type right_ ) = + (T_Type (case (({-# LINE 170 "PrintOcamlCode.ag" #-} + error "pp of Type.TEither is not supported" + {-# LINE 2116 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) ) +sem_Type_TIntMap :: T_Type -> + T_Type +sem_Type_TIntMap !(T_Type value_ ) = + (T_Type (case (({-# LINE 172 "PrintOcamlCode.ag" #-} + error "pp of Type.TIntMap is not supported" + {-# LINE 2125 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) ) +sem_Type_TMap :: T_Type -> + T_Type -> + T_Type +sem_Type_TMap !(T_Type key_ ) !(T_Type value_ ) = + (T_Type (case (({-# LINE 171 "PrintOcamlCode.ag" #-} + error "pp of Type.TMap is not supported" + {-# LINE 2135 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) ) +sem_Type_TMaybe :: T_Type -> + T_Type +sem_Type_TMaybe !(T_Type tp_ ) = + (T_Type (case (tp_ ) of + { ( !_tpIpp) -> + (case (({-# LINE 169 "PrintOcamlCode.ag" #-} + _tpIpp >#< "opt" + {-# LINE 2146 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) ) +sem_Type_TupleType :: T_Types -> + T_Type +sem_Type_TupleType !(T_Types tps_ ) = + (T_Type (case (tps_ ) of + { ( !_tpsIpps) -> + (case (({-# LINE 163 "PrintOcamlCode.ag" #-} + pp_block "(" ")" "," _tpsIpps + {-# LINE 2157 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) ) +sem_Type_TypeApp :: T_Type -> + T_Types -> + T_Type +sem_Type_TypeApp !(T_Type func_ ) !(T_Types args_ ) = + (T_Type (case (args_ ) of + { ( !_argsIpps) -> + (case (func_ ) of + { ( !_funcIpp) -> + (case (({-# LINE 162 "PrintOcamlCode.ag" #-} + pp_parens (hv_sp (_argsIpps ++ [_funcIpp])) + {-# LINE 2171 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) ) +sem_Type_UnboxedTupleType :: T_Types -> + T_Type +sem_Type_UnboxedTupleType !(T_Types tps_ ) = + (T_Type (case (({-# LINE 165 "PrintOcamlCode.ag" #-} + error "pp of Type.UnboxedTupleType is not supported" + {-# LINE 2180 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) ) +-- Types ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Type + child tl : Types + alternative Nil: +-} +-- cata +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 (( PP_Docs)) +data Inh_Types = Inh_Types {} +data Syn_Types = Syn_Types {pps_Syn_Types :: !(PP_Docs)} +wrap_Types :: T_Types -> + Inh_Types -> + Syn_Types +wrap_Types !(T_Types sem ) !(Inh_Types ) = + (let ( !_lhsOpps) = sem + in (Syn_Types _lhsOpps )) +sem_Types_Cons :: T_Type -> + T_Types -> + T_Types +sem_Types_Cons !(T_Type hd_ ) !(T_Types tl_ ) = + (T_Types (case (tl_ ) of + { ( !_tlIpps) -> + (case (hd_ ) of + { ( !_hdIpp) -> + (case (({-# LINE 72 "PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 2220 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) ) +sem_Types_Nil :: T_Types +sem_Types_Nil = + (T_Types (case (({-# LINE 73 "PrintOcamlCode.ag" #-} + [] + {-# LINE 2228 "PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) ) diff --git a/src-derived/PrintVisitCode.hs b/src-derived/PrintVisitCode.hs new file mode 100644 --- /dev/null +++ b/src-derived/PrintVisitCode.hs @@ -0,0 +1,762 @@ + + +-- UUAGC 0.9.38.1 (PrintVisitCode.ag) +module PrintVisitCode where +{-# LINE 10 "PrintVisitCode.ag" #-} + +import CommonTypes +import SequentialTypes +import Options +import CodeSyntax +import ErrorMessages +import GrammarInfo +import DeclBlocks +import Pretty + +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Set as Set +import Data.Set(Set) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq) +import UU.Scanner.Position + +import Data.List(partition,intersperse,intersect,(\\)) +import Maybe(fromJust,isJust) +{-# LINE 27 "../src-derived/PrintVisitCode.hs" #-} + +{-# LINE 2 "./CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 35 "../src-derived/PrintVisitCode.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 42 "../src-derived/PrintVisitCode.hs" #-} + +{-# LINE 2 "./DeclBlocks.ag" #-} + +import Code (Decl,Expr) +{-# LINE 47 "../src-derived/PrintVisitCode.hs" #-} +{-# LINE 32 "PrintVisitCode.ag" #-} + +type PP_Docs = [PP_Doc] + +ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeqH = ppMultiSeq' (>#<) + +ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeqV = ppMultiSeq' (>-<) + +ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeq' next strictArgs expr + = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs +{-# LINE 61 "../src-derived/PrintVisitCode.hs" #-} +-- CGrammar ---------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + output : PP_Docs + alternatives: + alternative CGrammar: + child typeSyns : {TypeSyns} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : CNonterminals + child pragmas : {PragmaMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + child multivisit : {Bool} +-} +-- cata +sem_CGrammar :: CGrammar -> + T_CGrammar +sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _nonts _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit ) = + (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CNonterminals _nonts ) _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit ) +-- semantic domain +newtype T_CGrammar = T_CGrammar (Options -> + ( PP_Docs)) +data Inh_CGrammar = Inh_CGrammar {options_Inh_CGrammar :: !(Options)} +data Syn_CGrammar = Syn_CGrammar {output_Syn_CGrammar :: !(PP_Docs)} +wrap_CGrammar :: T_CGrammar -> + Inh_CGrammar -> + Syn_CGrammar +wrap_CGrammar (T_CGrammar sem ) (Inh_CGrammar _lhsIoptions ) = + (let ( _lhsOoutput) = sem _lhsIoptions + in (Syn_CGrammar _lhsOoutput )) +sem_CGrammar_CGrammar :: TypeSyns -> + Derivings -> + (Set NontermIdent) -> + T_CNonterminals -> + PragmaMap -> + ParamMap -> + ContextMap -> + QuantMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + T_CGrammar +sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ = + (T_CGrammar (\ _lhsIoptions -> + (case (({-# LINE 53 "PrintVisitCode.ag" #-} + [] + {-# LINE 115 "PrintVisitCode.hs" #-} + )) of + { _lhsOoutput -> + ( _lhsOoutput) })) ) +-- CInterface -------------------------------------------------- +{- + alternatives: + alternative CInterface: + child seg : CSegments +-} +-- cata +sem_CInterface :: CInterface -> + T_CInterface +sem_CInterface (CInterface _seg ) = + (sem_CInterface_CInterface (sem_CSegments _seg ) ) +-- semantic domain +newtype T_CInterface = T_CInterface (( )) +data Inh_CInterface = Inh_CInterface {} +data Syn_CInterface = Syn_CInterface {} +wrap_CInterface :: T_CInterface -> + Inh_CInterface -> + Syn_CInterface +wrap_CInterface (T_CInterface sem ) (Inh_CInterface ) = + (let ( ) = sem + in (Syn_CInterface )) +sem_CInterface_CInterface :: T_CSegments -> + T_CInterface +sem_CInterface_CInterface (T_CSegments seg_ ) = + (T_CInterface ( ) ) +-- CNonterminal ------------------------------------------------ +{- + alternatives: + alternative CNonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : CProductions + child inter : CInterface +-} +-- cata +sem_CNonterminal :: CNonterminal -> + T_CNonterminal +sem_CNonterminal (CNonterminal _nt _params _inh _syn _prods _inter ) = + (sem_CNonterminal_CNonterminal _nt _params _inh _syn (sem_CProductions _prods ) (sem_CInterface _inter ) ) +-- semantic domain +newtype T_CNonterminal = T_CNonterminal (( )) +data Inh_CNonterminal = Inh_CNonterminal {} +data Syn_CNonterminal = Syn_CNonterminal {} +wrap_CNonterminal :: T_CNonterminal -> + Inh_CNonterminal -> + Syn_CNonterminal +wrap_CNonterminal (T_CNonterminal sem ) (Inh_CNonterminal ) = + (let ( ) = sem + in (Syn_CNonterminal )) +sem_CNonterminal_CNonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_CProductions -> + T_CInterface -> + T_CNonterminal +sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_ ) (T_CInterface inter_ ) = + (T_CNonterminal ( ) ) +-- CNonterminals ----------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CNonterminal + child tl : CNonterminals + alternative Nil: +-} +-- cata +sem_CNonterminals :: CNonterminals -> + T_CNonterminals +sem_CNonterminals list = + (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list) ) +-- semantic domain +newtype T_CNonterminals = T_CNonterminals (( )) +data Inh_CNonterminals = Inh_CNonterminals {} +data Syn_CNonterminals = Syn_CNonterminals {} +wrap_CNonterminals :: T_CNonterminals -> + Inh_CNonterminals -> + Syn_CNonterminals +wrap_CNonterminals (T_CNonterminals sem ) (Inh_CNonterminals ) = + (let ( ) = sem + in (Syn_CNonterminals )) +sem_CNonterminals_Cons :: T_CNonterminal -> + T_CNonterminals -> + T_CNonterminals +sem_CNonterminals_Cons (T_CNonterminal hd_ ) (T_CNonterminals tl_ ) = + (T_CNonterminals ( ) ) +sem_CNonterminals_Nil :: T_CNonterminals +sem_CNonterminals_Nil = + (T_CNonterminals ( ) ) +-- CProduction ------------------------------------------------- +{- + alternatives: + alternative CProduction: + child con : {ConstructorIdent} + child visits : CVisits + child children : {[(Identifier,Type,Maybe (Maybe Type))]} + child terminals : {[Identifier]} +-} +-- cata +sem_CProduction :: CProduction -> + T_CProduction +sem_CProduction (CProduction _con _visits _children _terminals ) = + (sem_CProduction_CProduction _con (sem_CVisits _visits ) _children _terminals ) +-- semantic domain +newtype T_CProduction = T_CProduction (( )) +data Inh_CProduction = Inh_CProduction {} +data Syn_CProduction = Syn_CProduction {} +wrap_CProduction :: T_CProduction -> + Inh_CProduction -> + Syn_CProduction +wrap_CProduction (T_CProduction sem ) (Inh_CProduction ) = + (let ( ) = sem + in (Syn_CProduction )) +sem_CProduction_CProduction :: ConstructorIdent -> + T_CVisits -> + ([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + T_CProduction +sem_CProduction_CProduction con_ (T_CVisits visits_ ) children_ terminals_ = + (T_CProduction ( ) ) +-- CProductions ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : CProduction + child tl : CProductions + alternative Nil: +-} +-- cata +sem_CProductions :: CProductions -> + T_CProductions +sem_CProductions list = + (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) ) +-- semantic domain +newtype T_CProductions = T_CProductions (( )) +data Inh_CProductions = Inh_CProductions {} +data Syn_CProductions = Syn_CProductions {} +wrap_CProductions :: T_CProductions -> + Inh_CProductions -> + Syn_CProductions +wrap_CProductions (T_CProductions sem ) (Inh_CProductions ) = + (let ( ) = sem + in (Syn_CProductions )) +sem_CProductions_Cons :: T_CProduction -> + T_CProductions -> + T_CProductions +sem_CProductions_Cons (T_CProduction hd_ ) (T_CProductions tl_ ) = + (T_CProductions ( ) ) +sem_CProductions_Nil :: T_CProductions +sem_CProductions_Nil = + (T_CProductions ( ) ) +-- CRule ------------------------------------------------------- +{- + alternatives: + alternative CChildVisit: + child name : {Identifier} + child nt : {NontermIdent} + child nr : {Int} + child inh : {Attributes} + child syn : {Attributes} + child isLast : {Bool} + alternative CRule: + child name : {Identifier} + child isIn : {Bool} + child hasCode : {Bool} + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child childnt : {Maybe NontermIdent} + child tp : {Maybe Type} + child pattern : Pattern + child rhs : {[String]} + child defines : {Map Int (Identifier,Identifier,Maybe Type)} + child owrt : {Bool} + child origin : {String} + child uses : {Set (Identifier, Identifier)} + child explicit : {Bool} + child mbNamed : {Maybe Identifier} +-} +-- cata +sem_CRule :: CRule -> + T_CRule +sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) = + (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast ) +sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses _explicit _mbNamed ) = + (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern ) _rhs _defines _owrt _origin _uses _explicit _mbNamed ) +-- semantic domain +newtype T_CRule = T_CRule (( )) +data Inh_CRule = Inh_CRule {} +data Syn_CRule = Syn_CRule {} +wrap_CRule :: T_CRule -> + Inh_CRule -> + Syn_CRule +wrap_CRule (T_CRule sem ) (Inh_CRule ) = + (let ( ) = sem + in (Syn_CRule )) +sem_CRule_CChildVisit :: Identifier -> + NontermIdent -> + Int -> + Attributes -> + Attributes -> + Bool -> + T_CRule +sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = + (T_CRule ( ) ) +sem_CRule_CRule :: Identifier -> + Bool -> + Bool -> + NontermIdent -> + ConstructorIdent -> + Identifier -> + (Maybe NontermIdent) -> + (Maybe Type) -> + T_Pattern -> + ([String]) -> + (Map Int (Identifier,Identifier,Maybe Type)) -> + Bool -> + String -> + (Set (Identifier, Identifier)) -> + Bool -> + (Maybe Identifier) -> + T_CRule +sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ = + (T_CRule ( ) ) +-- CSegment ---------------------------------------------------- +{- + alternatives: + alternative CSegment: + child inh : {Attributes} + child syn : {Attributes} +-} +-- cata +sem_CSegment :: CSegment -> + T_CSegment +sem_CSegment (CSegment _inh _syn ) = + (sem_CSegment_CSegment _inh _syn ) +-- semantic domain +newtype T_CSegment = T_CSegment (( )) +data Inh_CSegment = Inh_CSegment {} +data Syn_CSegment = Syn_CSegment {} +wrap_CSegment :: T_CSegment -> + Inh_CSegment -> + Syn_CSegment +wrap_CSegment (T_CSegment sem ) (Inh_CSegment ) = + (let ( ) = sem + in (Syn_CSegment )) +sem_CSegment_CSegment :: Attributes -> + Attributes -> + T_CSegment +sem_CSegment_CSegment inh_ syn_ = + (T_CSegment ( ) ) +-- CSegments --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CSegment + child tl : CSegments + alternative Nil: +-} +-- cata +sem_CSegments :: CSegments -> + T_CSegments +sem_CSegments list = + (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) ) +-- semantic domain +newtype T_CSegments = T_CSegments (( )) +data Inh_CSegments = Inh_CSegments {} +data Syn_CSegments = Syn_CSegments {} +wrap_CSegments :: T_CSegments -> + Inh_CSegments -> + Syn_CSegments +wrap_CSegments (T_CSegments sem ) (Inh_CSegments ) = + (let ( ) = sem + in (Syn_CSegments )) +sem_CSegments_Cons :: T_CSegment -> + T_CSegments -> + T_CSegments +sem_CSegments_Cons (T_CSegment hd_ ) (T_CSegments tl_ ) = + (T_CSegments ( ) ) +sem_CSegments_Nil :: T_CSegments +sem_CSegments_Nil = + (T_CSegments ( ) ) +-- CVisit ------------------------------------------------------ +{- + alternatives: + alternative CVisit: + child inh : {Attributes} + child syn : {Attributes} + child vss : Sequence + child intra : Sequence + child ordered : {Bool} +-} +-- cata +sem_CVisit :: CVisit -> + T_CVisit +sem_CVisit (CVisit _inh _syn _vss _intra _ordered ) = + (sem_CVisit_CVisit _inh _syn (sem_Sequence _vss ) (sem_Sequence _intra ) _ordered ) +-- semantic domain +newtype T_CVisit = T_CVisit (( )) +data Inh_CVisit = Inh_CVisit {} +data Syn_CVisit = Syn_CVisit {} +wrap_CVisit :: T_CVisit -> + Inh_CVisit -> + Syn_CVisit +wrap_CVisit (T_CVisit sem ) (Inh_CVisit ) = + (let ( ) = sem + in (Syn_CVisit )) +sem_CVisit_CVisit :: Attributes -> + Attributes -> + T_Sequence -> + T_Sequence -> + Bool -> + T_CVisit +sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_ ) (T_Sequence intra_ ) ordered_ = + (T_CVisit ( ) ) +-- CVisits ----------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CVisit + child tl : CVisits + alternative Nil: +-} +-- cata +sem_CVisits :: CVisits -> + T_CVisits +sem_CVisits list = + (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) ) +-- semantic domain +newtype T_CVisits = T_CVisits (( )) +data Inh_CVisits = Inh_CVisits {} +data Syn_CVisits = Syn_CVisits {} +wrap_CVisits :: T_CVisits -> + Inh_CVisits -> + Syn_CVisits +wrap_CVisits (T_CVisits sem ) (Inh_CVisits ) = + (let ( ) = sem + in (Syn_CVisits )) +sem_CVisits_Cons :: T_CVisit -> + T_CVisits -> + T_CVisits +sem_CVisits_Cons (T_CVisit hd_ ) (T_CVisits tl_ ) = + (T_CVisits ( ) ) +sem_CVisits_Nil :: T_CVisits +sem_CVisits_Nil = + (T_CVisits ( ) ) +-- DeclBlocks -------------------------------------------------- +{- + alternatives: + alternative DeclBlock: + child defs : {[Decl]} + child visit : {Decl} + child next : DeclBlocks + alternative DeclTerminator: + child defs : {[Decl]} + child result : {Expr} +-} +-- cata +sem_DeclBlocks :: DeclBlocks -> + T_DeclBlocks +sem_DeclBlocks (DeclBlock _defs _visit _next ) = + (sem_DeclBlocks_DeclBlock _defs _visit (sem_DeclBlocks _next ) ) +sem_DeclBlocks (DeclTerminator _defs _result ) = + (sem_DeclBlocks_DeclTerminator _defs _result ) +-- semantic domain +newtype T_DeclBlocks = T_DeclBlocks (( )) +data Inh_DeclBlocks = Inh_DeclBlocks {} +data Syn_DeclBlocks = Syn_DeclBlocks {} +wrap_DeclBlocks :: T_DeclBlocks -> + Inh_DeclBlocks -> + Syn_DeclBlocks +wrap_DeclBlocks (T_DeclBlocks sem ) (Inh_DeclBlocks ) = + (let ( ) = sem + in (Syn_DeclBlocks )) +sem_DeclBlocks_DeclBlock :: ([Decl]) -> + Decl -> + T_DeclBlocks -> + T_DeclBlocks +sem_DeclBlocks_DeclBlock defs_ visit_ (T_DeclBlocks next_ ) = + (T_DeclBlocks ( ) ) +sem_DeclBlocks_DeclTerminator :: ([Decl]) -> + Expr -> + T_DeclBlocks +sem_DeclBlocks_DeclTerminator defs_ result_ = + (T_DeclBlocks ( ) ) +-- DeclBlocksRoot ---------------------------------------------- +{- + alternatives: + alternative DeclBlocksRoot: + child blocks : DeclBlocks +-} +-- cata +sem_DeclBlocksRoot :: DeclBlocksRoot -> + T_DeclBlocksRoot +sem_DeclBlocksRoot (DeclBlocksRoot _blocks ) = + (sem_DeclBlocksRoot_DeclBlocksRoot (sem_DeclBlocks _blocks ) ) +-- semantic domain +newtype T_DeclBlocksRoot = T_DeclBlocksRoot (( )) +data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot {} +data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot {} +wrap_DeclBlocksRoot :: T_DeclBlocksRoot -> + Inh_DeclBlocksRoot -> + Syn_DeclBlocksRoot +wrap_DeclBlocksRoot (T_DeclBlocksRoot sem ) (Inh_DeclBlocksRoot ) = + (let ( ) = sem + in (Syn_DeclBlocksRoot )) +sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks -> + T_DeclBlocksRoot +sem_DeclBlocksRoot_DeclBlocksRoot (T_DeclBlocks blocks_ ) = + (T_DeclBlocksRoot ( ) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : SELF + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern )) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern )} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOcopy) = sem + in (Syn_Pattern _lhsOcopy )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (case (parts_ ) of + { ( _partsIcopy) -> + (case (pat_ ) of + { ( _patIcopy) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 598 "PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 603 "PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (case (pats_ ) of + { ( _patsIcopy) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 615 "PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 620 "PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (case (pat_ ) of + { ( _patIcopy) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 631 "PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 636 "PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (case (pats_ ) of + { ( _patsIcopy) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 648 "PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 653 "PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (case (({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 662 "PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 667 "PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : SELF + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( Patterns )) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns )} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOcopy) = sem + in (Syn_Patterns _lhsOcopy )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (case (tl_ ) of + { ( _tlIcopy) -> + (case (hd_ ) of + { ( _hdIcopy) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 711 "PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 716 "PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (case (({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 724 "PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 729 "PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) ) +-- Sequence ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CRule + child tl : Sequence + alternative Nil: +-} +-- cata +sem_Sequence :: Sequence -> + T_Sequence +sem_Sequence list = + (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) ) +-- semantic domain +newtype T_Sequence = T_Sequence (( )) +data Inh_Sequence = Inh_Sequence {} +data Syn_Sequence = Syn_Sequence {} +wrap_Sequence :: T_Sequence -> + Inh_Sequence -> + Syn_Sequence +wrap_Sequence (T_Sequence sem ) (Inh_Sequence ) = + (let ( ) = sem + in (Syn_Sequence )) +sem_Sequence_Cons :: T_CRule -> + T_Sequence -> + T_Sequence +sem_Sequence_Cons (T_CRule hd_ ) (T_Sequence tl_ ) = + (T_Sequence ( ) ) +sem_Sequence_Nil :: T_Sequence +sem_Sequence_Nil = + (T_Sequence ( ) ) diff --git a/src-derived/SemHsTokens.hs b/src-derived/SemHsTokens.hs new file mode 100644 --- /dev/null +++ b/src-derived/SemHsTokens.hs @@ -0,0 +1,793 @@ + + +-- UUAGC 0.9.38.1 (SemHsTokens.ag) +module SemHsTokens where +{-# LINE 4 "SemHsTokens.ag" #-} + +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,empty,singleton,(><)) +import Data.Foldable(toList) +import Pretty + +import TokenDef +import HsToken +import ErrorMessages +{-# LINE 16 "../src-derived/SemHsTokens.hs" #-} + +{-# LINE 2 "./HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 22 "../src-derived/SemHsTokens.hs" #-} +{-# LINE 57 "SemHsTokens.ag" #-} + +isNTname allnts (Just (NT nt _)) = nt `elem` allnts +isNTname allnts _ = False +{-# LINE 27 "../src-derived/SemHsTokens.hs" #-} +-- HsToken ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,Maybe (Maybe Type))] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + fieldnames : [Identifier] + nt : Identifier + synthesized attributes: + errors : Seq Error + tok : (Pos,String) + usedAttrs : [(Identifier,Identifier)] + usedFields : Seq Identifier + usedLocals : [Identifier] + alternatives: + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local addTrace : _ + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local _tup1 : _ + local errors : _ + local tok : _ + local usedLocals : _ + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGField _field _attr _pos _rdesc ) = + (sem_HsToken_AGField _field _attr _pos _rdesc ) +sem_HsToken (AGLocal _var _pos _rdesc ) = + (sem_HsToken_AGLocal _var _pos _rdesc ) +sem_HsToken (CharToken _value _pos ) = + (sem_HsToken_CharToken _value _pos ) +sem_HsToken (Err _mesg _pos ) = + (sem_HsToken_Err _mesg _pos ) +sem_HsToken (HsToken _value _pos ) = + (sem_HsToken_HsToken _value _pos ) +sem_HsToken (StrToken _value _pos ) = + (sem_HsToken_StrToken _value _pos ) +-- semantic domain +newtype T_HsToken = T_HsToken (([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + ([Identifier]) -> + Identifier -> + ( (Seq Error),((Pos,String)),([(Identifier,Identifier)]),(Seq Identifier),([Identifier]))) +data Inh_HsToken = Inh_HsToken {allfields_Inh_HsToken :: ([(Identifier,Type,Maybe (Maybe Type))]),allnts_Inh_HsToken :: ([Identifier]),attrs_Inh_HsToken :: ([(Identifier,Identifier)]),con_Inh_HsToken :: Identifier,fieldnames_Inh_HsToken :: ([Identifier]),nt_Inh_HsToken :: Identifier} +data Syn_HsToken = Syn_HsToken {errors_Syn_HsToken :: (Seq Error),tok_Syn_HsToken :: ((Pos,String)),usedAttrs_Syn_HsToken :: ([(Identifier,Identifier)]),usedFields_Syn_HsToken :: (Seq Identifier),usedLocals_Syn_HsToken :: ([Identifier])} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem ) (Inh_HsToken _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt ) = + (let ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt + in (Syn_HsToken _lhsOerrors _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals )) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOtok :: ((Pos,String)) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + -- "SemHsTokens.ag"(line 74, column 15) + _lhsOerrors = + ({-# LINE 74 "SemHsTokens.ag" #-} + if (field_,attr_) `elem` _lhsIattrs + then Seq.empty + else if not(field_ `elem` (_LHS : _LOC: _lhsIfieldnames)) + then Seq.singleton (UndefChild _lhsInt _lhsIcon field_) + else Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ attr_ False) + {-# LINE 130 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 88, column 13) + _lhsOusedAttrs = + ({-# LINE 88 "SemHsTokens.ag" #-} + [(field_,attr_)] + {-# LINE 136 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 115, column 8) + _addTrace = + ({-# LINE 115 "SemHsTokens.ag" #-} + case rdesc_ of + Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" + Nothing -> id + {-# LINE 144 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 118, column 8) + _lhsOtok = + ({-# LINE 118 "SemHsTokens.ag" #-} + (pos_, _addTrace $ attrname True field_ attr_) + {-# LINE 150 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 93, column 40) + _lhsOusedFields = + ({-# LINE 93 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 156 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 84, column 40) + _lhsOusedLocals = + ({-# LINE 84 "SemHsTokens.ag" #-} + [] + {-# LINE 162 "SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOusedFields :: (Seq Identifier) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedLocals :: ([Identifier]) + _lhsOtok :: ((Pos,String)) + -- "SemHsTokens.ag"(line 64, column 19) + __tup1 = + ({-# LINE 64 "SemHsTokens.ag" #-} + if var_ `elem` _lhsIfieldnames + then if isNTname _lhsIallnts (lookup var_ (map (\(n,t,_) -> (n,t)) _lhsIallfields)) + then (Seq.singleton(ChildAsLocal _lhsInt _lhsIcon var_), (pos_,fieldname var_), [] ) + else (Seq.empty, (pos_,fieldname var_), [] ) + else if (_LOC,var_) `elem` _lhsIattrs + then (Seq.empty , (pos_,locname var_), [var_]) + else (Seq.singleton(UndefLocal _lhsInt _lhsIcon var_), (pos_,locname var_), [] ) + {-# LINE 191 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 64, column 19) + (_errors,_,_) = + ({-# LINE 64 "SemHsTokens.ag" #-} + __tup1 + {-# LINE 197 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 64, column 19) + (_,_tok,_) = + ({-# LINE 64 "SemHsTokens.ag" #-} + __tup1 + {-# LINE 203 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 64, column 19) + (_,_,_usedLocals) = + ({-# LINE 64 "SemHsTokens.ag" #-} + __tup1 + {-# LINE 209 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 96, column 13) + _lhsOusedFields = + ({-# LINE 96 "SemHsTokens.ag" #-} + if var_ `elem` _lhsIfieldnames + then Seq.singleton var_ + else Seq.empty + {-# LINE 217 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "SemHsTokens.ag" #-} + _errors + {-# LINE 223 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 85, column 40) + _lhsOusedAttrs = + ({-# LINE 85 "SemHsTokens.ag" #-} + [] + {-# LINE 229 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 84, column 40) + _lhsOusedLocals = + ({-# LINE 84 "SemHsTokens.ag" #-} + _usedLocals + {-# LINE 235 "SemHsTokens.hs" #-} + ) + -- copy rule (from local) + _lhsOtok = + ({-# LINE 113 "SemHsTokens.ag" #-} + _tok + {-# LINE 241 "SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtok :: ((Pos,String)) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + -- "SemHsTokens.ag"(line 122, column 16) + _lhsOtok = + ({-# LINE 122 "SemHsTokens.ag" #-} + (pos_, if null value_ + then "" + else showCharShort (head value_) + ) + {-# LINE 266 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 272 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 85, column 40) + _lhsOusedAttrs = + ({-# LINE 85 "SemHsTokens.ag" #-} + [] + {-# LINE 278 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 93, column 40) + _lhsOusedFields = + ({-# LINE 93 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 284 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 84, column 40) + _lhsOusedLocals = + ({-# LINE 84 "SemHsTokens.ag" #-} + [] + {-# LINE 290 "SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOerrors :: (Seq Error) + _lhsOtok :: ((Pos,String)) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + -- "SemHsTokens.ag"(line 50, column 9) + _lhsOerrors = + ({-# LINE 50 "SemHsTokens.ag" #-} + let m = text mesg_ + in Seq.singleton (CustomError False pos_ m) + {-# LINE 313 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 128, column 16) + _lhsOtok = + ({-# LINE 128 "SemHsTokens.ag" #-} + (pos_, "") + {-# LINE 319 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 85, column 40) + _lhsOusedAttrs = + ({-# LINE 85 "SemHsTokens.ag" #-} + [] + {-# LINE 325 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 93, column 40) + _lhsOusedFields = + ({-# LINE 93 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 331 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 84, column 40) + _lhsOusedLocals = + ({-# LINE 84 "SemHsTokens.ag" #-} + [] + {-# LINE 337 "SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtok :: ((Pos,String)) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + -- "SemHsTokens.ag"(line 120, column 14) + _lhsOtok = + ({-# LINE 120 "SemHsTokens.ag" #-} + (pos_, value_) + {-# LINE 359 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 365 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 85, column 40) + _lhsOusedAttrs = + ({-# LINE 85 "SemHsTokens.ag" #-} + [] + {-# LINE 371 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 93, column 40) + _lhsOusedFields = + ({-# LINE 93 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 377 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 84, column 40) + _lhsOusedLocals = + ({-# LINE 84 "SemHsTokens.ag" #-} + [] + {-# LINE 383 "SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtok :: ((Pos,String)) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + -- "SemHsTokens.ag"(line 127, column 16) + _lhsOtok = + ({-# LINE 127 "SemHsTokens.ag" #-} + (pos_, showStrShort value_) + {-# LINE 405 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 411 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 85, column 40) + _lhsOusedAttrs = + ({-# LINE 85 "SemHsTokens.ag" #-} + [] + {-# LINE 417 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 93, column 40) + _lhsOusedFields = + ({-# LINE 93 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 423 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 84, column 40) + _lhsOusedLocals = + ({-# LINE 84 "SemHsTokens.ag" #-} + [] + {-# LINE 429 "SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +-- HsTokens ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,Maybe (Maybe Type))] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + fieldnames : [Identifier] + nt : Identifier + synthesized attributes: + errors : Seq Error + tks : [(Pos,String)] + usedAttrs : [(Identifier,Identifier)] + usedFields : Seq Identifier + usedLocals : [Identifier] + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) ) +-- semantic domain +newtype T_HsTokens = T_HsTokens (([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + ([Identifier]) -> + Identifier -> + ( (Seq Error),([(Pos,String)]),([(Identifier,Identifier)]),(Seq Identifier),([Identifier]))) +data Inh_HsTokens = Inh_HsTokens {allfields_Inh_HsTokens :: ([(Identifier,Type,Maybe (Maybe Type))]),allnts_Inh_HsTokens :: ([Identifier]),attrs_Inh_HsTokens :: ([(Identifier,Identifier)]),con_Inh_HsTokens :: Identifier,fieldnames_Inh_HsTokens :: ([Identifier]),nt_Inh_HsTokens :: Identifier} +data Syn_HsTokens = Syn_HsTokens {errors_Syn_HsTokens :: (Seq Error),tks_Syn_HsTokens :: ([(Pos,String)]),usedAttrs_Syn_HsTokens :: ([(Identifier,Identifier)]),usedFields_Syn_HsTokens :: (Seq Identifier),usedLocals_Syn_HsTokens :: ([Identifier])} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt ) = + (let ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt + in (Syn_HsTokens _lhsOerrors _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals )) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) = + (T_HsTokens (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtks :: ([(Pos,String)]) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + _hdOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _hdOallnts :: ([Identifier]) + _hdOattrs :: ([(Identifier,Identifier)]) + _hdOcon :: Identifier + _hdOfieldnames :: ([Identifier]) + _hdOnt :: Identifier + _tlOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _tlOallnts :: ([Identifier]) + _tlOattrs :: ([(Identifier,Identifier)]) + _tlOcon :: Identifier + _tlOfieldnames :: ([Identifier]) + _tlOnt :: Identifier + _hdIerrors :: (Seq Error) + _hdItok :: ((Pos,String)) + _hdIusedAttrs :: ([(Identifier,Identifier)]) + _hdIusedFields :: (Seq Identifier) + _hdIusedLocals :: ([Identifier]) + _tlIerrors :: (Seq Error) + _tlItks :: ([(Pos,String)]) + _tlIusedAttrs :: ([(Identifier,Identifier)]) + _tlIusedFields :: (Seq Identifier) + _tlIusedLocals :: ([Identifier]) + -- "SemHsTokens.ag"(line 110, column 10) + _lhsOtks = + ({-# LINE 110 "SemHsTokens.ag" #-} + _hdItok : _tlItks + {-# LINE 516 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "SemHsTokens.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 522 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 85, column 40) + _lhsOusedAttrs = + ({-# LINE 85 "SemHsTokens.ag" #-} + _hdIusedAttrs ++ _tlIusedAttrs + {-# LINE 528 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 93, column 40) + _lhsOusedFields = + ({-# LINE 93 "SemHsTokens.ag" #-} + _hdIusedFields Seq.>< _tlIusedFields + {-# LINE 534 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 84, column 40) + _lhsOusedLocals = + ({-# LINE 84 "SemHsTokens.ag" #-} + _hdIusedLocals ++ _tlIusedLocals + {-# LINE 540 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOallfields = + ({-# LINE 30 "SemHsTokens.ag" #-} + _lhsIallfields + {-# LINE 546 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 31 "SemHsTokens.ag" #-} + _lhsIallnts + {-# LINE 552 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 32 "SemHsTokens.ag" #-} + _lhsIattrs + {-# LINE 558 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 29 "SemHsTokens.ag" #-} + _lhsIcon + {-# LINE 564 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOfieldnames = + ({-# LINE 36 "SemHsTokens.ag" #-} + _lhsIfieldnames + {-# LINE 570 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 29 "SemHsTokens.ag" #-} + _lhsInt + {-# LINE 576 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOallfields = + ({-# LINE 30 "SemHsTokens.ag" #-} + _lhsIallfields + {-# LINE 582 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 31 "SemHsTokens.ag" #-} + _lhsIallnts + {-# LINE 588 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOattrs = + ({-# LINE 32 "SemHsTokens.ag" #-} + _lhsIattrs + {-# LINE 594 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 29 "SemHsTokens.ag" #-} + _lhsIcon + {-# LINE 600 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOfieldnames = + ({-# LINE 36 "SemHsTokens.ag" #-} + _lhsIfieldnames + {-# LINE 606 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 29 "SemHsTokens.ag" #-} + _lhsInt + {-# LINE 612 "SemHsTokens.hs" #-} + ) + ( _hdIerrors,_hdItok,_hdIusedAttrs,_hdIusedFields,_hdIusedLocals) = + hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOfieldnames _hdOnt + ( _tlIerrors,_tlItks,_tlIusedAttrs,_tlIusedFields,_tlIusedLocals) = + tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOfieldnames _tlOnt + in ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtks :: ([(Pos,String)]) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + -- "SemHsTokens.ag"(line 111, column 10) + _lhsOtks = + ({-# LINE 111 "SemHsTokens.ag" #-} + [] + {-# LINE 636 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 642 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 85, column 40) + _lhsOusedAttrs = + ({-# LINE 85 "SemHsTokens.ag" #-} + [] + {-# LINE 648 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 93, column 40) + _lhsOusedFields = + ({-# LINE 93 "SemHsTokens.ag" #-} + Seq.empty + {-# LINE 654 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 84, column 40) + _lhsOusedLocals = + ({-# LINE 84 "SemHsTokens.ag" #-} + [] + {-# LINE 660 "SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) +-- HsTokensRoot ------------------------------------------------ +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,Maybe (Maybe Type))] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + nt : Identifier + synthesized attributes: + errors : Seq Error + textLines : [String] + usedAttrs : [(Identifier,Identifier)] + usedFields : [Identifier] + usedLocals : [Identifier] + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +-- cata +sem_HsTokensRoot :: HsTokensRoot -> + T_HsTokensRoot +sem_HsTokensRoot (HsTokensRoot _tokens ) = + (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens ) ) +-- semantic domain +newtype T_HsTokensRoot = T_HsTokensRoot (([(Identifier,Type,Maybe (Maybe Type))]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Identifier -> + ( (Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier]))) +data Inh_HsTokensRoot = Inh_HsTokensRoot {allfields_Inh_HsTokensRoot :: ([(Identifier,Type,Maybe (Maybe Type))]),allnts_Inh_HsTokensRoot :: ([Identifier]),attrs_Inh_HsTokensRoot :: ([(Identifier,Identifier)]),con_Inh_HsTokensRoot :: Identifier,nt_Inh_HsTokensRoot :: Identifier} +data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: (Seq Error),textLines_Syn_HsTokensRoot :: ([String]),usedAttrs_Syn_HsTokensRoot :: ([(Identifier,Identifier)]),usedFields_Syn_HsTokensRoot :: ([Identifier]),usedLocals_Syn_HsTokensRoot :: ([Identifier])} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt ) = + (let ( _lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt + in (Syn_HsTokensRoot _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals )) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) = + (T_HsTokensRoot (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsInt -> + (let _tokensOfieldnames :: ([Identifier]) + _lhsOusedFields :: ([Identifier]) + _lhsOtextLines :: ([String]) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedLocals :: ([Identifier]) + _tokensOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) + _tokensOallnts :: ([Identifier]) + _tokensOattrs :: ([(Identifier,Identifier)]) + _tokensOcon :: Identifier + _tokensOnt :: Identifier + _tokensIerrors :: (Seq Error) + _tokensItks :: ([(Pos,String)]) + _tokensIusedAttrs :: ([(Identifier,Identifier)]) + _tokensIusedFields :: (Seq Identifier) + _tokensIusedLocals :: ([Identifier]) + -- "SemHsTokens.ag"(line 38, column 18) + _tokensOfieldnames = + ({-# LINE 38 "SemHsTokens.ag" #-} + map (\(n,_,_) -> n) _lhsIallfields + {-# LINE 730 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 100, column 18) + _lhsOusedFields = + ({-# LINE 100 "SemHsTokens.ag" #-} + toList _tokensIusedFields + {-# LINE 736 "SemHsTokens.hs" #-} + ) + -- "SemHsTokens.ag"(line 107, column 18) + _lhsOtextLines = + ({-# LINE 107 "SemHsTokens.ag" #-} + showTokens _tokensItks + {-# LINE 742 "SemHsTokens.hs" #-} + ) + -- use rule "SemHsTokens.ag"(line 18, column 18) + _lhsOerrors = + ({-# LINE 18 "SemHsTokens.ag" #-} + _tokensIerrors + {-# LINE 748 "SemHsTokens.hs" #-} + ) + -- copy rule (up) + _lhsOusedAttrs = + ({-# LINE 20 "SemHsTokens.ag" #-} + _tokensIusedAttrs + {-# LINE 754 "SemHsTokens.hs" #-} + ) + -- copy rule (up) + _lhsOusedLocals = + ({-# LINE 19 "SemHsTokens.ag" #-} + _tokensIusedLocals + {-# LINE 760 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOallfields = + ({-# LINE 30 "SemHsTokens.ag" #-} + _lhsIallfields + {-# LINE 766 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOallnts = + ({-# LINE 31 "SemHsTokens.ag" #-} + _lhsIallnts + {-# LINE 772 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOattrs = + ({-# LINE 32 "SemHsTokens.ag" #-} + _lhsIattrs + {-# LINE 778 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOcon = + ({-# LINE 29 "SemHsTokens.ag" #-} + _lhsIcon + {-# LINE 784 "SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOnt = + ({-# LINE 29 "SemHsTokens.ag" #-} + _lhsInt + {-# LINE 790 "SemHsTokens.hs" #-} + ) + ( _tokensIerrors,_tokensItks,_tokensIusedAttrs,_tokensIusedFields,_tokensIusedLocals) = + tokens_ _tokensOallfields _tokensOallnts _tokensOattrs _tokensOcon _tokensOfieldnames _tokensOnt + in ( _lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) diff --git a/src-derived/TfmToVisage.hs b/src-derived/TfmToVisage.hs new file mode 100644 --- /dev/null +++ b/src-derived/TfmToVisage.hs @@ -0,0 +1,1172 @@ + + +-- UUAGC 0.9.38.1 (TfmToVisage.ag) +module TfmToVisage where +{-# LINE 8 "TfmToVisage.ag" #-} + +import AbstractSyntax +import VisagePatterns +import VisageSyntax +{-# LINE 11 "../src-derived/TfmToVisage.hs" #-} + +{-# LINE 2 "./AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 21 "../src-derived/TfmToVisage.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 28 "../src-derived/TfmToVisage.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 34 "../src-derived/TfmToVisage.hs" #-} +{-# LINE 14 "TfmToVisage.ag" #-} + +-- Maps a rule to a pair +-- Later, I expect to map to a list of rules, because we might need to unfold. + + +-- Checks that a certain alias is in fact a Var in the old representation of the AG system +isVar (Alias _ _ (Underscore _) _) = True +isVar _ = False + +type VisageRuleMap = [(String, VisageRule)] + +splitVRules :: [VisageRule] -> VisageRuleMap +splitVRules vrs = concat (map unfoldvrs vrs) + +unfoldvrs :: VisageRule -> VisageRuleMap +unfoldvrs vr@(VRule attrfields _ _ _ _) = zip (map (getName . fst) attrfields) (map (copyRule vr) attrfields) + +copyRule :: VisageRule -> (Identifier,Identifier) -> VisageRule +copyRule (VRule attrfields _ pat expr owrt) (field,attr) = VRule attrfields attr pat expr owrt + +getForField :: String -> VisageRuleMap -> [VisageRule] +getForField field xs = map snd (filter ((field ==) . fst) xs) + +{- + Delivers a map from fieldname to VisageRule with all references to others underscored. + So, (lhs.x, rt.y, loc.z) = (0,1,2) becomes something like + [("lhs", (lhs.x,_,_) = (0,1,2) + + At this point, we do not use this anymore. + +allways :: VisageRule -> VisageRuleMap +allways vr@(VRule vrfields _ _ _ _) = zip vrfields (map (underScoreRule vr) (nub vrfields)) + +splitVRules :: [VisageRule] -> VisageRuleMap +splitVRules vrs = concat (map allways vrs) + +underScoreRule :: VisageRule -> String -> VisageRule +underScoreRule (VRule fields pat expr owrt rule) s = VRule fields (underScore s pat) expr owrt rule + +underScore :: String -> VisagePattern -> VisagePattern +underScore field (VConstr name pats) = VConstr name (map (underScore field) pats) +underScore field (VProduct pos pats) = VProduct pos (map (underScore field) pats) +underScore field vp@(VVar vfield attr) = + if (field == getName vfield) + then vp + else (VUnderscore (getPos vfield)) +-- Should I recurse into the pat of VAlias? +underScore field vp@(VAlias afield attr pat) = + if (field == getName afield) + then vp + else (VUnderscore (getPos afield)) +underScore field vp@(VUnderscore pos) = vp + +-} +{-# LINE 90 "../src-derived/TfmToVisage.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attribute: + rulemap : VisageRuleMap + synthesized attribute: + vchild : VisageChild + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _inh _syn _virtual ) = + (sem_Child_Child _name _tp _inh _syn _virtual ) +-- semantic domain +newtype T_Child = T_Child (VisageRuleMap -> + ( VisageChild)) +data Inh_Child = Inh_Child {rulemap_Inh_Child :: VisageRuleMap} +data Syn_Child = Syn_Child {vchild_Syn_Child :: VisageChild} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem ) (Inh_Child _lhsIrulemap ) = + (let ( _lhsOvchild) = sem _lhsIrulemap + in (Syn_Child _lhsOvchild )) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + (Maybe (Maybe Type)) -> + T_Child +sem_Child_Child name_ tp_ inh_ syn_ virtual_ = + (T_Child (\ _lhsIrulemap -> + (let _lhsOvchild :: VisageChild + -- "TfmToVisage.ag"(line 118, column 11) + _lhsOvchild = + ({-# LINE 118 "TfmToVisage.ag" #-} + VChild name_ tp_ inh_ syn_ (getForField (getName name_) _lhsIrulemap) + {-# LINE 135 "TfmToVisage.hs" #-} + ) + in ( _lhsOvchild))) ) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attribute: + rulemap : VisageRuleMap + synthesized attribute: + vchildren : [VisageChild] + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) +-- semantic domain +newtype T_Children = T_Children (VisageRuleMap -> + ( ([VisageChild]))) +data Inh_Children = Inh_Children {rulemap_Inh_Children :: VisageRuleMap} +data Syn_Children = Syn_Children {vchildren_Syn_Children :: ([VisageChild])} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem ) (Inh_Children _lhsIrulemap ) = + (let ( _lhsOvchildren) = sem _lhsIrulemap + in (Syn_Children _lhsOvchildren )) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = + (T_Children (\ _lhsIrulemap -> + (let _lhsOvchildren :: ([VisageChild]) + _hdOrulemap :: VisageRuleMap + _tlOrulemap :: VisageRuleMap + _hdIvchild :: VisageChild + _tlIvchildren :: ([VisageChild]) + -- "TfmToVisage.ag"(line 114, column 17) + _lhsOvchildren = + ({-# LINE 114 "TfmToVisage.ag" #-} + _hdIvchild : _tlIvchildren + {-# LINE 181 "TfmToVisage.hs" #-} + ) + -- copy rule (down) + _hdOrulemap = + ({-# LINE 80 "TfmToVisage.ag" #-} + _lhsIrulemap + {-# LINE 187 "TfmToVisage.hs" #-} + ) + -- copy rule (down) + _tlOrulemap = + ({-# LINE 81 "TfmToVisage.ag" #-} + _lhsIrulemap + {-# LINE 193 "TfmToVisage.hs" #-} + ) + ( _hdIvchild) = + hd_ _hdOrulemap + ( _tlIvchildren) = + tl_ _tlOrulemap + in ( _lhsOvchildren))) ) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ _lhsIrulemap -> + (let _lhsOvchildren :: ([VisageChild]) + -- "TfmToVisage.ag"(line 115, column 17) + _lhsOvchildren = + ({-# LINE 115 "TfmToVisage.ag" #-} + [] + {-# LINE 208 "TfmToVisage.hs" #-} + ) + in ( _lhsOvchildren))) ) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : SELF + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local self : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = 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 (T_Expression sem ) (Inh_Expression ) = + (let ( _lhsOself) = sem + in (Syn_Expression _lhsOself )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOself :: Expression + -- self rule + _self = + ({-# LINE 71 "TfmToVisage.ag" #-} + Expression pos_ tks_ + {-# LINE 247 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 71 "TfmToVisage.ag" #-} + _self + {-# LINE 253 "TfmToVisage.hs" #-} + ) + in ( _lhsOself)) ) +-- Grammar ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + visage : VisageGrammar + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) +-- semantic domain +newtype T_Grammar = T_Grammar (( VisageGrammar)) +data Inh_Grammar = Inh_Grammar {} +data Syn_Grammar = Syn_Grammar {visage_Syn_Grammar :: VisageGrammar} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem ) (Inh_Grammar ) = + (let ( _lhsOvisage) = sem + in (Syn_Grammar _lhsOvisage )) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (let _lhsOvisage :: VisageGrammar + _nontsIvnonts :: ([VisageNonterminal]) + -- "TfmToVisage.ag"(line 87, column 7) + _lhsOvisage = + ({-# LINE 87 "TfmToVisage.ag" #-} + VGrammar _nontsIvnonts + {-# LINE 315 "TfmToVisage.hs" #-} + ) + ( _nontsIvnonts) = + nonts_ + in ( _lhsOvisage)) ) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + synthesized attribute: + vnont : VisageNonterminal + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions +-} +-- cata +sem_Nonterminal :: Nonterminal -> + T_Nonterminal +sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods ) = + (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) +-- semantic domain +newtype T_Nonterminal = T_Nonterminal (( VisageNonterminal)) +data Inh_Nonterminal = Inh_Nonterminal {} +data Syn_Nonterminal = Syn_Nonterminal {vnont_Syn_Nonterminal :: VisageNonterminal} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal ) = + (let ( _lhsOvnont) = sem + in (Syn_Nonterminal _lhsOvnont )) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = + (T_Nonterminal (let _lhsOvnont :: VisageNonterminal + _prodsIvprods :: ([VisageProduction]) + -- "TfmToVisage.ag"(line 97, column 7) + _lhsOvnont = + ({-# LINE 97 "TfmToVisage.ag" #-} + VNonterminal nt_ inh_ syn_ _prodsIvprods + {-# LINE 361 "TfmToVisage.hs" #-} + ) + ( _prodsIvprods) = + prods_ + in ( _lhsOvnont)) ) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + synthesized attribute: + vnonts : [VisageNonterminal] + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals (( ([VisageNonterminal]))) +data Inh_Nonterminals = Inh_Nonterminals {} +data Syn_Nonterminals = Syn_Nonterminals {vnonts_Syn_Nonterminals :: ([VisageNonterminal])} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals ) = + (let ( _lhsOvnonts) = sem + in (Syn_Nonterminals _lhsOvnonts )) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = + (T_Nonterminals (let _lhsOvnonts :: ([VisageNonterminal]) + _hdIvnont :: VisageNonterminal + _tlIvnonts :: ([VisageNonterminal]) + -- "TfmToVisage.ag"(line 91, column 7) + _lhsOvnonts = + ({-# LINE 91 "TfmToVisage.ag" #-} + _hdIvnont : _tlIvnonts + {-# LINE 403 "TfmToVisage.hs" #-} + ) + ( _hdIvnont) = + hd_ + ( _tlIvnonts) = + tl_ + in ( _lhsOvnonts)) ) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (let _lhsOvnonts :: ([VisageNonterminal]) + -- "TfmToVisage.ag"(line 93, column 7) + _lhsOvnonts = + ({-# LINE 93 "TfmToVisage.ag" #-} + [] + {-# LINE 417 "TfmToVisage.hs" #-} + ) + in ( _lhsOvnonts)) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + fieldattrs : [(Identifier,Identifier)] + self : SELF + vpat : VisagePattern + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + local self : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local self : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + local self : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local self : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ + local self : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern ,( [(Identifier,Identifier)] ),Pattern ,VisagePattern)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern ,fieldattrs_Syn_Pattern :: ( [(Identifier,Identifier)] ),self_Syn_Pattern :: Pattern ,vpat_Syn_Pattern :: VisagePattern} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat) = sem + in (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOvpat :: VisagePattern + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + _patIcopy :: Pattern + _patIfieldattrs :: ( [(Identifier,Identifier)] ) + _patIself :: Pattern + _patIvpat :: VisagePattern + _partsIcopy :: Patterns + _partsIfieldattrs :: ( [(Identifier,Identifier)] ) + _partsIself :: Patterns + _partsIvpats :: ([VisagePattern]) + -- "TfmToVisage.ag"(line 135, column 17) + _lhsOvpat = + ({-# LINE 135 "TfmToVisage.ag" #-} + if (isVar _self) + then VVar field_ attr_ + else VAlias field_ attr_ _patIvpat + {-# LINE 507 "TfmToVisage.hs" #-} + ) + -- "TfmToVisage.ag"(line 144, column 17) + _lhsOfieldattrs = + ({-# LINE 144 "TfmToVisage.ag" #-} + [(field_, attr_)] + {-# LINE 513 "TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 519 "TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 71 "TfmToVisage.ag" #-} + Alias field_ attr_ _patIself _partsIself + {-# LINE 525 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 531 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 71 "TfmToVisage.ag" #-} + _self + {-# LINE 537 "TfmToVisage.hs" #-} + ) + ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) = + pat_ + ( _partsIcopy,_partsIfieldattrs,_partsIself,_partsIvpats) = + parts_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOvpat :: VisagePattern + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + _patsIcopy :: Patterns + _patsIfieldattrs :: ( [(Identifier,Identifier)] ) + _patsIself :: Patterns + _patsIvpats :: ([VisagePattern]) + -- "TfmToVisage.ag"(line 133, column 17) + _lhsOvpat = + ({-# LINE 133 "TfmToVisage.ag" #-} + VConstr name_ _patsIvpats + {-# LINE 560 "TfmToVisage.hs" #-} + ) + -- use rule "TfmToVisage.ag"(line 141, column 43) + _lhsOfieldattrs = + ({-# LINE 141 "TfmToVisage.ag" #-} + _patsIfieldattrs + {-# LINE 566 "TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 572 "TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 71 "TfmToVisage.ag" #-} + Constr name_ _patsIself + {-# LINE 578 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 584 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 71 "TfmToVisage.ag" #-} + _self + {-# LINE 590 "TfmToVisage.hs" #-} + ) + ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) = + pats_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + _lhsOvpat :: VisagePattern + _patIcopy :: Pattern + _patIfieldattrs :: ( [(Identifier,Identifier)] ) + _patIself :: Pattern + _patIvpat :: VisagePattern + -- use rule "TfmToVisage.ag"(line 141, column 43) + _lhsOfieldattrs = + ({-# LINE 141 "TfmToVisage.ag" #-} + _patIfieldattrs + {-# LINE 610 "TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 616 "TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 71 "TfmToVisage.ag" #-} + Irrefutable _patIself + {-# LINE 622 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 628 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 71 "TfmToVisage.ag" #-} + _self + {-# LINE 634 "TfmToVisage.hs" #-} + ) + -- copy rule (up) + _lhsOvpat = + ({-# LINE 82 "TfmToVisage.ag" #-} + _patIvpat + {-# LINE 640 "TfmToVisage.hs" #-} + ) + ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) = + pat_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOvpat :: VisagePattern + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + _patsIcopy :: Patterns + _patsIfieldattrs :: ( [(Identifier,Identifier)] ) + _patsIself :: Patterns + _patsIvpats :: ([VisagePattern]) + -- "TfmToVisage.ag"(line 134, column 17) + _lhsOvpat = + ({-# LINE 134 "TfmToVisage.ag" #-} + VProduct pos_ _patsIvpats + {-# LINE 661 "TfmToVisage.hs" #-} + ) + -- use rule "TfmToVisage.ag"(line 141, column 43) + _lhsOfieldattrs = + ({-# LINE 141 "TfmToVisage.ag" #-} + _patsIfieldattrs + {-# LINE 667 "TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 673 "TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 71 "TfmToVisage.ag" #-} + Product pos_ _patsIself + {-# LINE 679 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 685 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 71 "TfmToVisage.ag" #-} + _self + {-# LINE 691 "TfmToVisage.hs" #-} + ) + ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) = + pats_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOvpat :: VisagePattern + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + -- "TfmToVisage.ag"(line 138, column 17) + _lhsOvpat = + ({-# LINE 138 "TfmToVisage.ag" #-} + VUnderscore pos_ + {-# LINE 707 "TfmToVisage.hs" #-} + ) + -- use rule "TfmToVisage.ag"(line 141, column 43) + _lhsOfieldattrs = + ({-# LINE 141 "TfmToVisage.ag" #-} + [] + {-# LINE 713 "TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 719 "TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 71 "TfmToVisage.ag" #-} + Underscore pos_ + {-# LINE 725 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 731 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 71 "TfmToVisage.ag" #-} + _self + {-# LINE 737 "TfmToVisage.hs" #-} + ) + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + fieldattrs : [(Identifier,Identifier)] + self : SELF + vpats : [VisagePattern] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + local self : _ + alternative Nil: + visit 0: + local copy : _ + local self : _ +-} +-- cata +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 (( Patterns ,( [(Identifier,Identifier)] ),Patterns ,([VisagePattern]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns ,fieldattrs_Syn_Patterns :: ( [(Identifier,Identifier)] ),self_Syn_Patterns :: Patterns ,vpats_Syn_Patterns :: ([VisagePattern])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats) = sem + in (Syn_Patterns _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOvpats :: ([VisagePattern]) + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Patterns + _lhsOself :: Patterns + _hdIcopy :: Pattern + _hdIfieldattrs :: ( [(Identifier,Identifier)] ) + _hdIself :: Pattern + _hdIvpat :: VisagePattern + _tlIcopy :: Patterns + _tlIfieldattrs :: ( [(Identifier,Identifier)] ) + _tlIself :: Patterns + _tlIvpats :: ([VisagePattern]) + -- "TfmToVisage.ag"(line 129, column 17) + _lhsOvpats = + ({-# LINE 129 "TfmToVisage.ag" #-} + _hdIvpat : _tlIvpats + {-# LINE 795 "TfmToVisage.hs" #-} + ) + -- use rule "TfmToVisage.ag"(line 141, column 43) + _lhsOfieldattrs = + ({-# LINE 141 "TfmToVisage.ag" #-} + _hdIfieldattrs ++ _tlIfieldattrs + {-# LINE 801 "TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 807 "TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 71 "TfmToVisage.ag" #-} + (:) _hdIself _tlIself + {-# LINE 813 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 819 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 71 "TfmToVisage.ag" #-} + _self + {-# LINE 825 "TfmToVisage.hs" #-} + ) + ( _hdIcopy,_hdIfieldattrs,_hdIself,_hdIvpat) = + hd_ + ( _tlIcopy,_tlIfieldattrs,_tlIself,_tlIvpats) = + tl_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOvpats :: ([VisagePattern]) + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Patterns + _lhsOself :: Patterns + -- "TfmToVisage.ag"(line 130, column 17) + _lhsOvpats = + ({-# LINE 130 "TfmToVisage.ag" #-} + [] + {-# LINE 842 "TfmToVisage.hs" #-} + ) + -- use rule "TfmToVisage.ag"(line 141, column 43) + _lhsOfieldattrs = + ({-# LINE 141 "TfmToVisage.ag" #-} + [] + {-# LINE 848 "TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 854 "TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 71 "TfmToVisage.ag" #-} + [] + {-# LINE 860 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 866 "TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 71 "TfmToVisage.ag" #-} + _self + {-# LINE 872 "TfmToVisage.hs" #-} + ) + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats)) ) +-- Production -------------------------------------------------- +{- + visit 0: + synthesized attribute: + vprod : VisageProduction + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + visit 0: + local splitVRules : _ + local locrules : _ + local lhsrules : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _children _rules _typeSigs ) = + (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) +-- semantic domain +newtype T_Production = T_Production (( VisageProduction)) +data Inh_Production = Inh_Production {} +data Syn_Production = Syn_Production {vprod_Syn_Production :: VisageProduction} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem ) (Inh_Production ) = + (let ( _lhsOvprod) = sem + in (Syn_Production _lhsOvprod )) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = + (T_Production (let _lhsOvprod :: VisageProduction + _childrenOrulemap :: VisageRuleMap + _childrenIvchildren :: ([VisageChild]) + _rulesIvrules :: ([VisageRule]) + -- "TfmToVisage.ag"(line 107, column 7) + _lhsOvprod = + ({-# LINE 107 "TfmToVisage.ag" #-} + VProduction con_ _childrenIvchildren _lhsrules _locrules + {-# LINE 920 "TfmToVisage.hs" #-} + ) + -- "TfmToVisage.ag"(line 108, column 7) + _splitVRules = + ({-# LINE 108 "TfmToVisage.ag" #-} + splitVRules _rulesIvrules + {-# LINE 926 "TfmToVisage.hs" #-} + ) + -- "TfmToVisage.ag"(line 109, column 7) + _locrules = + ({-# LINE 109 "TfmToVisage.ag" #-} + getForField "loc" _splitVRules + {-# LINE 932 "TfmToVisage.hs" #-} + ) + -- "TfmToVisage.ag"(line 110, column 7) + _lhsrules = + ({-# LINE 110 "TfmToVisage.ag" #-} + getForField "lhs" _splitVRules + {-# LINE 938 "TfmToVisage.hs" #-} + ) + -- "TfmToVisage.ag"(line 111, column 7) + _childrenOrulemap = + ({-# LINE 111 "TfmToVisage.ag" #-} + _splitVRules + {-# LINE 944 "TfmToVisage.hs" #-} + ) + ( _childrenIvchildren) = + children_ _childrenOrulemap + ( _rulesIvrules) = + rules_ + in ( _lhsOvprod)) ) +-- Productions ------------------------------------------------- +{- + visit 0: + synthesized attribute: + vprods : [VisageProduction] + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) +-- semantic domain +newtype T_Productions = T_Productions (( ([VisageProduction]))) +data Inh_Productions = Inh_Productions {} +data Syn_Productions = Syn_Productions {vprods_Syn_Productions :: ([VisageProduction])} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem ) (Inh_Productions ) = + (let ( _lhsOvprods) = sem + in (Syn_Productions _lhsOvprods )) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = + (T_Productions (let _lhsOvprods :: ([VisageProduction]) + _hdIvprod :: VisageProduction + _tlIvprods :: ([VisageProduction]) + -- "TfmToVisage.ag"(line 101, column 7) + _lhsOvprods = + ({-# LINE 101 "TfmToVisage.ag" #-} + _hdIvprod : _tlIvprods + {-# LINE 988 "TfmToVisage.hs" #-} + ) + ( _hdIvprod) = + hd_ + ( _tlIvprods) = + tl_ + in ( _lhsOvprods)) ) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (let _lhsOvprods :: ([VisageProduction]) + -- "TfmToVisage.ag"(line 103, column 7) + _lhsOvprods = + ({-# LINE 103 "TfmToVisage.ag" #-} + [] + {-# LINE 1002 "TfmToVisage.hs" #-} + ) + in ( _lhsOvprods)) ) +-- Rule -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + vrule : VisageRule + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) +-- semantic domain +newtype T_Rule = T_Rule (( VisageRule)) +data Inh_Rule = Inh_Rule {} +data Syn_Rule = Syn_Rule {vrule_Syn_Rule :: VisageRule} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem ) (Inh_Rule ) = + (let ( _lhsOvrule) = sem + in (Syn_Rule _lhsOvrule )) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = + (T_Rule (let _lhsOvrule :: VisageRule + _patternIcopy :: Pattern + _patternIfieldattrs :: ( [(Identifier,Identifier)] ) + _patternIself :: Pattern + _patternIvpat :: VisagePattern + _rhsIself :: Expression + -- "TfmToVisage.ag"(line 126, column 11) + _lhsOvrule = + ({-# LINE 126 "TfmToVisage.ag" #-} + VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_ + {-# LINE 1052 "TfmToVisage.hs" #-} + ) + ( _patternIcopy,_patternIfieldattrs,_patternIself,_patternIvpat) = + pattern_ + ( _rhsIself) = + rhs_ + in ( _lhsOvrule)) ) +-- Rules ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + vrules : [VisageRule] + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) +-- semantic domain +newtype T_Rules = T_Rules (( ([VisageRule]))) +data Inh_Rules = Inh_Rules {} +data Syn_Rules = Syn_Rules {vrules_Syn_Rules :: ([VisageRule])} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem ) (Inh_Rules ) = + (let ( _lhsOvrules) = sem + in (Syn_Rules _lhsOvrules )) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) = + (T_Rules (let _lhsOvrules :: ([VisageRule]) + _hdIvrule :: VisageRule + _tlIvrules :: ([VisageRule]) + -- "TfmToVisage.ag"(line 121, column 17) + _lhsOvrules = + ({-# LINE 121 "TfmToVisage.ag" #-} + _hdIvrule : _tlIvrules + {-# LINE 1096 "TfmToVisage.hs" #-} + ) + ( _hdIvrule) = + hd_ + ( _tlIvrules) = + tl_ + in ( _lhsOvrules)) ) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (let _lhsOvrules :: ([VisageRule]) + -- "TfmToVisage.ag"(line 122, column 17) + _lhsOvrules = + ({-# LINE 122 "TfmToVisage.ag" #-} + [] + {-# LINE 1110 "TfmToVisage.hs" #-} + ) + in ( _lhsOvrules)) ) +-- TypeSig ----------------------------------------------------- +{- + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp ) = + (sem_TypeSig_TypeSig _name _tp ) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( )) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) = + (let ( ) = sem + in (Syn_TypeSig )) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let + in ( )) ) +-- TypeSigs ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( )) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) = + (let ( ) = sem + in (Syn_TypeSigs )) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) = + (T_TypeSigs (let + in ( )) ) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let + in ( )) ) diff --git a/src-derived/Transform.hs b/src-derived/Transform.hs new file mode 100644 --- /dev/null +++ b/src-derived/Transform.hs @@ -0,0 +1,7194 @@ + + +-- UUAGC 0.9.38.2 (Transform.ag) +module Transform where +{-# LINE 8 "Transform.ag" #-} + +import Control.Monad(mplus,mzero) +import List (partition, elem, nub,intersperse) +import Data.Maybe +import qualified Data.Map as Map +import Data.Map (Map) +import Data.Set as Set (Set, member, union, toList, fromList, empty, singleton, member, unions, size, fold, intersection, difference, insert) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq, empty, (><),fromList) +import Data.Foldable(toList) +import UU.Scanner.Position(noPos) + +import ConcreteSyntax +import AbstractSyntax +import ErrorMessages +import Patterns (Patterns(..),Pattern(..)) +import Expression (Expression(..)) +import HsToken + +import Options +import CommonTypes +import RhsCheck +{-# LINE 29 "../src-derived/Transform.hs" #-} + +{-# LINE 2 "./ConcreteSyntax.ag" #-} + +import UU.Scanner.Position (Pos) +import Patterns (Pattern) +import Expression (Expression) +import CommonTypes +{-# LINE 37 "../src-derived/Transform.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 44 "../src-derived/Transform.hs" #-} +{-# LINE 102 "Transform.ag" #-} +type DefinedSets = Map Identifier (Set NontermIdent) +{-# LINE 47 "../src-derived/Transform.hs" #-} + +{-# LINE 122 "Transform.ag" #-} +type FieldMap = [(Identifier, Type)] +{-# LINE 51 "../src-derived/Transform.hs" #-} + +{-# LINE 123 "Transform.ag" #-} +type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) +{-# LINE 55 "../src-derived/Transform.hs" #-} + +{-# LINE 143 "Transform.ag" #-} +type AttrName = (Identifier,Identifier) +{-# LINE 59 "../src-derived/Transform.hs" #-} + +{-# LINE 144 "Transform.ag" #-} +type RuleInfo = (Maybe Identifier, [AttrName]->Pattern, Expression, [AttrName], Bool, String) +{-# LINE 63 "../src-derived/Transform.hs" #-} + +{-# LINE 145 "Transform.ag" #-} +type SigInfo = (Identifier,Type) +{-# LINE 67 "../src-derived/Transform.hs" #-} + +{-# LINE 146 "Transform.ag" #-} +type UniqueInfo = (Identifier,Identifier) +{-# LINE 71 "../src-derived/Transform.hs" #-} + +{-# LINE 147 "Transform.ag" #-} +type AugmentInfo = (Identifier,Expression) +{-# LINE 75 "../src-derived/Transform.hs" #-} + +{-# LINE 148 "Transform.ag" #-} +type AroundInfo = (Identifier,Expression) +{-# LINE 79 "../src-derived/Transform.hs" #-} + +{-# LINE 149 "Transform.ag" #-} +type MergeInfo = (Identifier, Identifier, [Identifier], Expression) +{-# LINE 83 "../src-derived/Transform.hs" #-} + +{-# LINE 203 "Transform.ag" #-} + + +checkDuplicate :: (Identifier -> Identifier -> Error) + -> Identifier -> val -> Map Identifier val -> (Map Identifier val,Seq Error) +checkDuplicate dupError key val m + = case Map.lookupIndex key m of + Just ix -> let (key',_) = Map.elemAt ix m + in (m,Seq.singleton (dupError key key')) + Nothing -> (Map.insert key val m,Seq.empty) + +checkDuplicates :: (Identifier -> Identifier -> Error) + -> [(Identifier, val)] -> Map Identifier val -> (Map Identifier val,Seq Error) +checkDuplicates dupError new m = foldErrors check m new + where check = uncurry (checkDuplicate dupError) + +foldErrors f e xs = foldl g (e,Seq.empty) xs + where g ~(e,es) x = let (e',es') = f x e + in (e', es >< es') + + +checkForDuplicates :: (Identifier -> Identifier -> Error) -> [Identifier] -> [Error] +checkForDuplicates err [] = [] +checkForDuplicates err (x:xs) = let (same,other) = List.partition (equalId x) xs + in map (err x) same ++ checkForDuplicates err other + +equalId :: Identifier -> Identifier -> Bool +equalId x y = getName x == getName y + +{-# LINE 114 "../src-derived/Transform.hs" #-} + +{-# LINE 339 "Transform.ag" #-} + +type RulesAndErrors = ([Rule], Seq Error) +type SigsAndErrors = ([TypeSig], Seq Error) +type InstsAndErrors = ([(Identifier, Type)], Seq Error) +type UniquesAndErrors = (Map Identifier Identifier, Seq Error) +type AugmentsAndErrors = (Map Identifier [Expression], Seq Error) +type AroundsAndErrors = (Map Identifier [Expression], Seq Error) +type MergesAndErrors = (Map Identifier (Identifier, [Identifier], Expression), Seq Error) +type AttrOverwrite = Map AttrName Bool +type AccumRuleCheck = (RulesAndErrors, AttrOverwrite) +type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName]) + +checkRules :: Map NontermIdent (Attributes, Attributes) -> Map NontermIdent (Map ConstructorIdent FieldMap) -> + Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> + Map NontermIdent (Map ConstructorIdent [MergeInfo]) -> + NontermIdent -> ConstructorIdent -> [RuleInfo] -> RulesAndErrors +checkRules attributes fields allinsts allsigs allmerges nt con rs + = let fieldmap :: FieldMap + fieldmap = (_LHS,NT nt undefined) : (_LOC,NT undefined undefined) : (_INST, NT undefined undefined) : (_FIRST, NT undefined undefined) : (_LAST, NT undefined undefined) + : Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fields) + ++ mapMaybe (\instNm -> lookup instNm sigs >>= \tp -> return (instNm, tp)) (Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allinsts)) + -- merged children are not allowed to have any inherited attrs defined: do not include + + sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allsigs) + + hasAttrib f tp attr = Map.member attr (f (Map.findWithDefault (Map.empty,Map.empty) tp attributes)) + + checkRule :: RuleInfo -> AccumRuleCheck -> AccumRuleCheck + checkRule (mbNm, pat,exp,as,owrt,str) ((r1,e1),m1) + = let (e2,m2,u2,b2) = foldr (checkDefi owrt) (e1,m1,[],[]) as + in ( (Rule mbNm (pat u2) exp owrt str True : r1, e2), m2) + + checkDefi :: Bool -> AttrName -> AccumDefiCheck -> AccumDefiCheck + checkDefi owrt fa@(field,attr) (e,m,u,bs) + = case lookup field fieldmap + of Just (NT tp _) -> + let tp' = maybe tp id (deforestedNt tp) + in if field == _LOC || field == _INST || field == _FIRST || field == _LAST + || hasAttrib (if getName field==getName _LHS then snd else fst) tp' attr + then case Map.lookupIndex fa m of + Just ix -> let ((_,attr2),b) = Map.elemAt ix m + in if b && not (fa `elem` bs) + then ( e, Map.insert fa owrt m, fa:u, fa:bs) + else (((Seq.<|)) (DupRule nt con field attr2 attr) e, m, fa:u, bs) + Nothing -> ( e, Map.insert fa owrt m, u, fa:bs) + else (((Seq.<|)) (SuperfluousRule nt con field attr) e, m, fa:u, bs) + _ -> (((Seq.<|)) (UndefChild nt con field) e, m, fa:u, bs ) + + in fst (foldr checkRule (([],Seq.empty),Map.empty) rs) + +checkRuleNames :: NontermIdent -> ConstructorIdent -> [RuleInfo] -> Seq Error +checkRuleNames nt con + = fst . foldr checkRule (Seq.empty, Set.empty) + where + checkRule (Just nm,_,_,_,_,_) (errs, nms) + | nm `Set.member` nms = (DupRuleName nt con nm Seq.<| errs, nms) + | otherwise = (errs, Set.insert nm nms) + checkRule (Nothing,_,_,_,_,_) inp = inp + +checkSigs :: NontermIdent -> ConstructorIdent -> [SigInfo] -> SigsAndErrors +checkSigs nt con sis + = let checkSig (ide,typ) (sigs,errs) + = if ide `elem` map (\(TypeSig n t)-> n) sigs + then (sigs, ((Seq.<|)) (DupSig nt con ide) errs) + -- else if not (ide `elem` locattrdefs) + -- then (sigs, ((Seq.<|)) (SupSig nt con ide) errs) + else (TypeSig ide typ:sigs, errs) + in foldr checkSig ([],Seq.empty) sis + +checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors +checkInsts allNts sigMap fieldMap nt con + = foldr (\inst (insts, errs) -> + maybe (insts, Seq.singleton (MissingInstSig nt con inst) >< errs) + (\info@(k, NT nm _) -> + case findInst k insts of + Just k' -> (insts, Seq.singleton (DupChild nt con k k') >< errs) + Nothing -> case nm `Set.member` allNts of + True -> (info : insts, errs) + False | take 2 (getName nm) == "T_" -> let nm' = Ident (drop 2 (getName nm)) (getPos nm) + in case nm' `Set.member` allNts of + True -> (info : insts, errs) + False -> (insts, Seq.singleton (UndefNont nm') >< errs) + | otherwise -> (insts, Seq.singleton (UndefNont nm) >< errs) + ) + $ findSig inst + ) ([], Seq.empty) + where + sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt sigMap) + + findSig name + = do tp@(NT _ _) <- lookup name sigs + return (name, tp) + + findInst _ [] = Nothing + findInst k ((k', _): r) + | k == k' = Just k' + | otherwise = findInst k r + +checkUniques :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [UniqueInfo] -> UniquesAndErrors +checkUniques allAttrs nt con uniques + = let checkUnique (ident,ref) (us,errs) + = if ident `Map.member` us + then (us, ((Seq.<|)) (DupUnique nt con ident) errs) + else if Map.member ref inhs && Map.member ref syns + then (Map.insert ident ref us, errs) + else (us, ((Seq.<|)) (MissingUnique nt ref) errs) + + (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs + in foldr checkUnique (Map.empty, Seq.empty) uniques + +checkAugments :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [AugmentInfo] -> AugmentsAndErrors +checkAugments allAttrs nt con augments + = let checkAugment (ident,expr) (as,errs) + = if ident `Map.member` as + then (Map.update (\vs -> Just (vs ++ [expr])) ident as, errs) + else if Map.member ident syns + then (Map.insert ident [expr] as, errs) + else (as, ((Seq.<|)) (MissingSyn nt ident) errs) + + (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs + in foldr checkAugment (Map.empty, Seq.empty) augments + +checkArounds :: Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [AroundInfo] -> AroundsAndErrors +checkArounds fieldMap nt con arounds + = let checkAround (ident,expr) (as,errs) + = if ident `Map.member` as + then (Map.update (\vs -> Just (vs ++ [expr])) ident as, errs) + else case lookup ident fields of + Just (NT _ _) -> (Map.insert ident [expr] as, errs) + _ -> (as, ((Seq.<|)) (UndefChild nt con ident) errs) + fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap) + in foldr checkAround (Map.empty, Seq.empty) arounds + +checkMerges :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [MergeInfo] -> MergesAndErrors +checkMerges allNts allInsts fieldMap nt con merges + = let checkMerge (target,nt,sources,expr) (m,errs) + = let fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap) + insts = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allInsts) + allFields = insts ++ map fst fields -- note: sources of merge may not contain a target (for simplicity) + in if target `Map.member` m -- check for duplicate with self + then (m, DupChild nt con target (fst $ Map.elemAt (Map.findIndex target m) m) Seq.<| errs) + else if target `elem` allFields + then (m, DupChild nt con target (head $ filter (== target) allFields) Seq.<| errs) + else let missing = filter (\s -> not (s `elem` allFields)) sources + in if null missing + then if nt `Set.member` allNts -- check if the nonterm is defined + then (Map.insert target (nt, sources, expr) m, errs) -- all ok.. + else (m, UndefNont nt Seq.<| errs) + else (m, (Seq.fromList $ map (UndefChild nt con) missing) Seq.>< errs) + in foldr checkMerge (Map.empty, Seq.empty) merges + +unionunionplusplus = Map.unionWith (Map.unionWith (++)) +{-# LINE 269 "../src-derived/Transform.hs" #-} + +{-# LINE 494 "Transform.ag" #-} + +mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule] +mkUniqueRules opts allFields allInsts allAttrDecls nt con usMap + = map apply groups + where + fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allFields) + ++ Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allInsts) + -- may have duplicates + + groups = Map.assocs $ Map.foldrWithKey (\i r m -> Map.insertWith (++) r [i] m) Map.empty usMap + apply (ref,us) = mkRule ref (findOutField ref) us + findOutField ref = case [ chld | (chld,NT tp _) <- fields, tp `hasSyn` ref] of + [] -> _LHS + (x:_) -> x + hasSyn tp ref = Map.member ref $ snd $ Map.findWithDefault (Map.empty,Map.empty) tp allAttrDecls + mkRule ref outFld locAttrs + = let pat = Product noPos (attr outFld ref : [attr _LOC u | u <- locAttrs ]) + rhs = Expression noPos $ wrap ref $ foldr gencase (finalout locAttrs) locAttrs + -- [HsToken ("mkUniques" ++ show (length locAttrs) ++ " ") noPos, AGField _LHS ref noPos Nothing] + in Rule Nothing pat rhs False "-- generated by the unique rule mechanism." False + attr fld a = Alias fld a (Underscore noPos) [] + gencase nm outp + = h ("case " ++ uniqueDispenser opts ++ " __cont of { (__cont, " ++ getName nm ++ ") -> ") ++ outp ++ h "}" + h s = [HsToken s noPos] + finalout us = h ("(__cont, " ++ concat (intersperse "," (map getName us)) ++ ")") + wrap ref inp = h "let __cont = " ++ [AGField _LHS ref noPos Nothing] ++ h " in seq __cont ( " ++ inp ++ h " )" +{-# LINE 298 "../src-derived/Transform.hs" #-} + +{-# LINE 692 "Transform.ag" #-} + +flattenDatas :: DataTypes -> Map NontermIdent (Set NontermIdent) +flattenDatas ds = Map.map flatten ds + where flatten cs = Set.fromList [ nt | (_,NT nt _) <- concatMap snd (Map.toList cs)] + +reachableFrom :: Map NontermIdent (Set NontermIdent) -> Set NontermIdent -> Set NontermIdent +reachableFrom table nts = reach nts + where reach nts = let nts' = Set.unions (nts : [ ns | nt <- Set.toList nts + , let ns = Map.findWithDefault Set.empty nt table ]) + in if Set.size nts' > Set.size nts + then reach nts' + else nts +invert :: Map NontermIdent (Set NontermIdent) -> Map NontermIdent (Set NontermIdent) +invert m = foldr inv Map.empty (Map.toList m) + where inv (x,ns) m = fold (\n m -> Map.insertWith Set.union n (Set.singleton x) m) m ns + +path :: Map NontermIdent (Set NontermIdent) -> NontermIdent -> NontermIdent -> Set NontermIdent +path table from to = let children = Map.findWithDefault Set.empty from table + forward = reachableFrom table children + backward = reachableFrom (invert table) + (Set.singleton to) + in Set.intersection forward backward +{-# LINE 323 "../src-derived/Transform.hs" #-} + +{-# LINE 809 "Transform.ag" #-} + +pragmaMapUnion :: PragmaMap -> PragmaMap -> PragmaMap +pragmaMapUnion = Map.unionWith (Map.unionWith Set.union) + +pragmaMapSingle :: NontermIdent -> ConstructorIdent -> Set Identifier -> PragmaMap +pragmaMapSingle nt con nms = Map.singleton nt (Map.singleton con nms) +{-# LINE 332 "../src-derived/Transform.hs" #-} + +{-# LINE 841 "Transform.ag" #-} + +orderMapUnion :: AttrOrderMap -> AttrOrderMap -> AttrOrderMap +orderMapUnion = Map.unionWith (Map.unionWith Set.union) + +orderMapSingle :: NontermIdent -> ConstructorIdent -> Set Dependency -> AttrOrderMap +orderMapSingle nt con deps = Map.singleton nt (Map.singleton con deps) +{-# LINE 341 "../src-derived/Transform.hs" #-} + +{-# LINE 867 "Transform.ag" #-} + +mergeParams :: ParamMap -> ParamMap -> ParamMap +mergeParams = Map.unionWith (++) +{-# LINE 347 "../src-derived/Transform.hs" #-} + +{-# LINE 890 "Transform.ag" #-} + +mergeCtx :: ContextMap -> ContextMap -> ContextMap +mergeCtx + = Map.unionWith nubconcat + where nubconcat a b = nub (a ++ b) +{-# LINE 355 "../src-derived/Transform.hs" #-} + +{-# LINE 909 "Transform.ag" #-} + +mergeQuant :: QuantMap -> QuantMap -> QuantMap +mergeQuant = Map.unionWith (++) +{-# LINE 361 "../src-derived/Transform.hs" #-} + +{-# LINE 920 "Transform.ag" #-} + +mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1) +{-# LINE 366 "../src-derived/Transform.hs" #-} + +{-# LINE 931 "Transform.ag" #-} + +merge x y = foldr f y (Map.toList x) + where f ~(k,v) m = Map.insertWith (Map.union) k v m +{-# LINE 372 "../src-derived/Transform.hs" #-} + +{-# LINE 972 "Transform.ag" #-} + +checkAttrs allFields nts inherited synthesized decls = foldErrors check decls nts where + check nt decls | not (nt `Map.member` allFields) = (decls,Seq.singleton(UndefNont nt)) + | otherwise = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt decls + (inh',einh) = checkDuplicates (DupInhAttr nt) inherited inh + (syn',esyn) = checkDuplicates (DupSynAttr nt) synthesized syn + in (Map.insert nt (inh',syn') decls,einh >< esyn) +{-# LINE 382 "../src-derived/Transform.hs" #-} + +{-# LINE 983 "Transform.ag" #-} + +addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap + in Map.insert name (eInh, Map.insert (Ident "self" noPos) (NT _SELF []) eSyn)atMap +{-# LINE 388 "../src-derived/Transform.hs" #-} + +{-# LINE 1124 "Transform.ag" #-} + +makeType :: Set NontermIdent -> Type -> Type +makeType nts tp@(NT x _) | x == _SELF = tp + | Set.member x nts = tp + | otherwise = Haskell (typeToHaskellString Nothing [] tp) +makeType _ tp = tp +{-# LINE 397 "../src-derived/Transform.hs" #-} + +{-# LINE 1131 "Transform.ag" #-} + +constructGrammar :: Set NontermIdent + -> ParamMap + -> DataTypes + -> Map NontermIdent (Attributes, Attributes) + -> Map NontermIdent (Map Identifier (String, String, String)) + -> Derivings + -> Set NontermIdent + -> Map NontermIdent (Map ConstructorIdent [Rule]) + -> Map NontermIdent (Map ConstructorIdent [TypeSig]) + -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) + -> TypeSyns + -> PragmaMap + -> AttrOrderMap + -> ContextMap + -> QuantMap + -> UniqueMap + -> Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + -> Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + -> Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) + -> Grammar + +constructGrammar nts ntParams gram attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap = + let gr = [ (nt,Map.toList alts) | (nt,alts) <- Map.toList gram] + nonts = map nont gr + nont (nt,alts) = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt attrs + rmap = Map.findWithDefault Map.empty nt allrules + tsmap = Map.findWithDefault Map.empty nt tsigs + instsmap = Map.findWithDefault Map.empty nt allinsts + params = Map.findWithDefault [] nt ntParams + mergemap = Map.findWithDefault Map.empty nt mergeMap + alt (con,flds) = + let rules = maybe [] id (Map.lookup con rmap) + tsigs = maybe [] id (Map.lookup con tsmap) + insts = maybe [] id (Map.lookup con instsmap) + merges = [ (n, NT t []) | (n, (t, _, _)) <- Map.assocs $ maybe Map.empty id (Map.lookup con mergemap) ] + + -- important: keep order of children + cldrn = map child (flds ++ filter (not . existsAsField) insts ++ merges) + child (nm, tp) = + let tpI = if existsAsInst nm + then fromJust $ lookup nm insts + else tp + (inh,syn) = case tpI of + NT nt _ -> let nt' = maybe nt id (deforestedNt nt) + in Map.findWithDefault (Map.empty,Map.empty) nt' attrs + _ -> (Map.empty,Map.empty) + virt = if existsAsInst nm + then case lookup nm flds of + Just tp' -> Just (Just tp') + Nothing -> Just Nothing + else if existsAsMerge nm + then (Just Nothing) + else Nothing + in Child nm tpI inh syn virt + existsAsInst nm = maybe False (const True) (lookup nm insts) + existsAsField (nm,_) = maybe False (const True) (lookup nm flds) + existsAsMerge nm = maybe False (const True) (lookup nm merges) + in Production con cldrn rules tsigs + in Nonterminal nt params inh syn (map alt alts) + in Grammar tsyns uses derivings wrappers nonts pragmaMap orderMap ntParams contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap +{-# LINE 461 "../src-derived/Transform.hs" #-} + +{-# LINE 1194 "Transform.ag" #-} + +mapUnionWithSetUnion = Map.unionWith Set.union +mapUnionWithPlusPlus = Map.unionWith (++) +{-# LINE 467 "../src-derived/Transform.hs" #-} +-- AG ---------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + blocks : Blocks + errors : Seq Error + moduleDecl : Maybe (String,String,String) + output : Grammar + pragmas : Options -> Options + alternatives: + alternative AG: + child elems : Elems + visit 0: + local allFields : _ + local allConstrs : _ + local allRules : _ + local allSigs : _ + local allInsts : _ + local allUniques : _ + local allAugments : _ + local allArounds : _ + local allMerges : _ + local augmentSigs : _ + local allRulesErrs : _ + local allNamesErrs : _ + local allSigsErrs : _ + local allInstsErrs : _ + local allUniquesErrs : _ + local allAugmentErrs : _ + local allAroundsErrs : _ + local allMergesErrs : _ + local checkedRulesPre : _ + local checkedSigs : _ + local checkedInsts : _ + local checkedUniques : _ + local checkedAugments : _ + local checkedArounds : _ + local checkedRules : _ + local checkedMerges : _ + local errs1 : _ + local errs2 : _ + local errs3 : _ + local errs4 : _ + local errs5 : _ + local errs6 : _ + local errs7 : _ + local errs8 : _ + local errs9 : _ + local errs10 : _ + local errs11 : _ + local allNonterminals : _ + local allAttrDecls : _ +-} +-- cata +sem_AG :: AG -> + T_AG +sem_AG (AG _elems ) = + (sem_AG_AG (sem_Elems _elems ) ) +-- semantic domain +newtype T_AG = T_AG (Options -> + ( Blocks,(Seq Error),(Maybe (String,String,String)),Grammar,(Options -> Options))) +data Inh_AG = Inh_AG {options_Inh_AG :: !(Options)} +data Syn_AG = Syn_AG {blocks_Syn_AG :: !(Blocks),errors_Syn_AG :: !((Seq Error)),moduleDecl_Syn_AG :: !((Maybe (String,String,String))),output_Syn_AG :: !(Grammar),pragmas_Syn_AG :: !((Options -> Options))} +wrap_AG :: T_AG -> + Inh_AG -> + Syn_AG +wrap_AG (T_AG sem ) (Inh_AG _lhsIoptions ) = + (let ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas) = sem _lhsIoptions + in (Syn_AG _lhsOblocks _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas )) +sem_AG_AG :: T_Elems -> + T_AG +sem_AG_AG (T_Elems elems_ ) = + (T_AG (\ _lhsIoptions -> + (let _lhsOoutput :: Grammar + _lhsOerrors :: (Seq Error) + _elemsOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _elemsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _elemsOdefinedSets :: DefinedSets + _elemsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOblocks :: Blocks + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOpragmas :: (Options -> Options) + _elemsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _elemsOallFields :: DataTypes + _elemsOallNonterminals :: (Set NontermIdent) + _elemsOoptions :: Options + _elemsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _elemsIattrOrderCollect :: AttrOrderMap + _elemsIblocks :: Blocks + _elemsIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _elemsIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _elemsIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _elemsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _elemsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _elemsIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _elemsIcollectedNames :: (Set Identifier) + _elemsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _elemsIcollectedSetNames :: (Set Identifier) + _elemsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _elemsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _elemsIctxCollect :: ContextMap + _elemsIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _elemsIderivings :: Derivings + _elemsIerrors :: (Seq Error) + _elemsImoduleDecl :: (Maybe (String,String,String)) + _elemsIparamsCollect :: ParamMap + _elemsIpragmas :: (Options -> Options) + _elemsIquantCollect :: QuantMap + _elemsIsemPragmasCollect :: PragmaMap + _elemsItypeSyns :: TypeSyns + _elemsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _elemsIwrappers :: (Set NontermIdent) + -- "Transform.ag"(line 52, column 8) + _lhsOoutput = + ({-# LINE 52 "Transform.ag" #-} + constructGrammar _allNonterminals + _elemsIparamsCollect + _allFields + _allAttrDecls + _elemsIuseMap + _elemsIderivings + (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers) + _checkedRules + _checkedSigs + _checkedInsts + _elemsItypeSyns + _elemsIsemPragmasCollect + _elemsIattrOrderCollect + _elemsIctxCollect + _elemsIquantCollect + _checkedUniques + _checkedAugments + _checkedArounds + _checkedMerges + {-# LINE 604 "Transform.hs" #-} + ) + -- "Transform.ag"(line 254, column 10) + _allFields = + ({-# LINE 254 "Transform.ag" #-} + let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) + in foldr f (Map.empty) _elemsIcollectedFields + {-# LINE 611 "Transform.hs" #-} + ) + -- "Transform.ag"(line 257, column 10) + _allConstrs = + ({-# LINE 257 "Transform.ag" #-} + let f (nt,con,_) = Map.insertWith (++) nt [con] + in foldr f (Map.empty) _elemsIcollectedFields + {-# LINE 618 "Transform.hs" #-} + ) + -- "Transform.ag"(line 260, column 10) + _allRules = + ({-# LINE 260 "Transform.ag" #-} + let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r]) + in foldr f (Map.empty) _elemsIcollectedRules + {-# LINE 625 "Transform.hs" #-} + ) + -- "Transform.ag"(line 263, column 10) + _allSigs = + ({-# LINE 263 "Transform.ag" #-} + let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t]) + typeof nt r = Map.findWithDefault (Haskell "") r $ fst $ Map.findWithDefault (Map.empty,Map.empty) nt _allAttrDecls + in foldr f (Map.empty) ( _elemsIcollectedSigs + ++ [ (nt, con, (ident,typeof nt ref)) | (nt, con, us) <- _elemsIcollectedUniques, (ident,ref) <- us ] + ) + {-# LINE 635 "Transform.hs" #-} + ) + -- "Transform.ag"(line 269, column 10) + _allInsts = + ({-# LINE 269 "Transform.ag" #-} + let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is) + in foldr f (Map.empty) _elemsIcollectedInsts + {-# LINE 642 "Transform.hs" #-} + ) + -- "Transform.ag"(line 272, column 10) + _allUniques = + ({-# LINE 272 "Transform.ag" #-} + let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us) + in foldr f (Map.empty) _elemsIcollectedUniques + {-# LINE 649 "Transform.hs" #-} + ) + -- "Transform.ag"(line 274, column 10) + _allAugments = + ({-# LINE 274 "Transform.ag" #-} + let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty _elemsIcollectedAugments + {-# LINE 656 "Transform.hs" #-} + ) + -- "Transform.ag"(line 276, column 10) + _allArounds = + ({-# LINE 276 "Transform.ag" #-} + let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty _elemsIcollectedArounds + {-# LINE 663 "Transform.hs" #-} + ) + -- "Transform.ag"(line 278, column 10) + _allMerges = + ({-# LINE 278 "Transform.ag" #-} + let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty _elemsIcollectedMerges + {-# LINE 670 "Transform.hs" #-} + ) + -- "Transform.ag"(line 281, column 10) + _augmentSigs = + ({-# LINE 281 "Transform.ag" #-} + let gen mp = [] + in Map.map (Map.map gen) _allAugments + {-# LINE 677 "Transform.hs" #-} + ) + -- "Transform.ag"(line 284, column 10) + _allRulesErrs = + ({-# LINE 284 "Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs _allMerges )) _allRules + {-# LINE 683 "Transform.hs" #-} + ) + -- "Transform.ag"(line 285, column 10) + _allNamesErrs = + ({-# LINE 285 "Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . checkRuleNames) _allRules + {-# LINE 689 "Transform.hs" #-} + ) + -- "Transform.ag"(line 286, column 10) + _allSigsErrs = + ({-# LINE 286 "Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs + {-# LINE 695 "Transform.hs" #-} + ) + -- "Transform.ag"(line 287, column 10) + _allInstsErrs = + ({-# LINE 287 "Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs _allFields )) _allInsts + {-# LINE 701 "Transform.hs" #-} + ) + -- "Transform.ag"(line 288, column 10) + _allUniquesErrs = + ({-# LINE 288 "Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques + {-# LINE 707 "Transform.hs" #-} + ) + -- "Transform.ag"(line 289, column 10) + _allAugmentErrs = + ({-# LINE 289 "Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkAugments _allAttrDecls )) _allAugments + {-# LINE 713 "Transform.hs" #-} + ) + -- "Transform.ag"(line 290, column 10) + _allAroundsErrs = + ({-# LINE 290 "Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkArounds _allFields )) _allArounds + {-# LINE 719 "Transform.hs" #-} + ) + -- "Transform.ag"(line 291, column 10) + _allMergesErrs = + ({-# LINE 291 "Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkMerges _allNonterminals _allInsts _allFields )) _allMerges + {-# LINE 725 "Transform.hs" #-} + ) + -- "Transform.ag"(line 293, column 10) + _checkedRulesPre = + ({-# LINE 293 "Transform.ag" #-} + Map.map (Map.map fst) _allRulesErrs + {-# LINE 731 "Transform.hs" #-} + ) + -- "Transform.ag"(line 294, column 10) + _checkedSigs = + ({-# LINE 294 "Transform.ag" #-} + Map.map (Map.map fst) _allSigsErrs `unionunionplusplus` _augmentSigs + {-# LINE 737 "Transform.hs" #-} + ) + -- "Transform.ag"(line 295, column 10) + _checkedInsts = + ({-# LINE 295 "Transform.ag" #-} + Map.map (Map.map fst) _allInstsErrs + {-# LINE 743 "Transform.hs" #-} + ) + -- "Transform.ag"(line 296, column 10) + _checkedUniques = + ({-# LINE 296 "Transform.ag" #-} + Map.map (Map.map fst) _allUniquesErrs + {-# LINE 749 "Transform.hs" #-} + ) + -- "Transform.ag"(line 297, column 10) + _checkedAugments = + ({-# LINE 297 "Transform.ag" #-} + Map.map (Map.map fst) _allAugmentErrs + {-# LINE 755 "Transform.hs" #-} + ) + -- "Transform.ag"(line 298, column 10) + _checkedArounds = + ({-# LINE 298 "Transform.ag" #-} + Map.map (Map.map fst) _allAroundsErrs + {-# LINE 761 "Transform.hs" #-} + ) + -- "Transform.ag"(line 299, column 10) + _checkedRules = + ({-# LINE 299 "Transform.ag" #-} + Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allFields _checkedInsts _allAttrDecls )) _checkedUniques ) + {-# LINE 767 "Transform.hs" #-} + ) + -- "Transform.ag"(line 300, column 10) + _checkedMerges = + ({-# LINE 300 "Transform.ag" #-} + Map.map (Map.map fst) _allMergesErrs + {-# LINE 773 "Transform.hs" #-} + ) + -- "Transform.ag"(line 302, column 10) + _errs1 = + ({-# LINE 302 "Transform.ag" #-} + let f = checkForDuplicates (DupSynonym) + in Seq.fromList . f . map fst $ _elemsItypeSyns + {-# LINE 780 "Transform.hs" #-} + ) + -- "Transform.ag"(line 305, column 10) + _errs2 = + ({-# LINE 305 "Transform.ag" #-} + let g nt (con,fm) = checkForDuplicates (DupChild nt con) (map fst fm) + f (nt,cfm) = concat . map (g nt) . Map.toList $ cfm + in Seq.fromList . concat . map f . Map.toList $ _allFields + {-# LINE 788 "Transform.hs" #-} + ) + -- "Transform.ag"(line 309, column 10) + _errs3 = + ({-# LINE 309 "Transform.ag" #-} + let f (nt,cons) = checkForDuplicates (DupAlt nt) cons + in Seq.empty + {-# LINE 795 "Transform.hs" #-} + ) + -- "Transform.ag"(line 313, column 10) + _errs4 = + ({-# LINE 313 "Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allRulesErrs + {-# LINE 802 "Transform.hs" #-} + ) + -- "Transform.ag"(line 316, column 10) + _errs5 = + ({-# LINE 316 "Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allSigsErrs + {-# LINE 809 "Transform.hs" #-} + ) + -- "Transform.ag"(line 319, column 10) + _errs6 = + ({-# LINE 319 "Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allInstsErrs + {-# LINE 816 "Transform.hs" #-} + ) + -- "Transform.ag"(line 322, column 10) + _errs7 = + ({-# LINE 322 "Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allUniquesErrs + {-# LINE 823 "Transform.hs" #-} + ) + -- "Transform.ag"(line 325, column 10) + _errs8 = + ({-# LINE 325 "Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allAugmentErrs + {-# LINE 830 "Transform.hs" #-} + ) + -- "Transform.ag"(line 328, column 10) + _errs9 = + ({-# LINE 328 "Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allAroundsErrs + {-# LINE 837 "Transform.hs" #-} + ) + -- "Transform.ag"(line 331, column 10) + _errs10 = + ({-# LINE 331 "Transform.ag" #-} + let f m s = Map.fold ((><)) s m + in Map.fold f Seq.empty _allNamesErrs + {-# LINE 844 "Transform.hs" #-} + ) + -- "Transform.ag"(line 334, column 10) + _errs11 = + ({-# LINE 334 "Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allMergesErrs + {-# LINE 851 "Transform.hs" #-} + ) + -- "Transform.ag"(line 337, column 10) + _lhsOerrors = + ({-# LINE 337 "Transform.ag" #-} + _elemsIerrors >< _errs1 >< _errs2 >< _errs3 >< _errs4 >< _errs5 >< _errs6 >< _errs7 >< _errs8 >< _errs9 >< _errs10 >< _errs11 + {-# LINE 857 "Transform.hs" #-} + ) + -- "Transform.ag"(line 561, column 10) + _allNonterminals = + ({-# LINE 561 "Transform.ag" #-} + _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames + {-# LINE 863 "Transform.hs" #-} + ) + -- "Transform.ag"(line 581, column 8) + _elemsOallConstructors = + ({-# LINE 581 "Transform.ag" #-} + _elemsIcollectedConstructorsMap + {-# LINE 869 "Transform.hs" #-} + ) + -- "Transform.ag"(line 654, column 8) + _elemsOdefSets = + ({-# LINE 654 "Transform.ag" #-} + Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals )) + {-# LINE 875 "Transform.hs" #-} + ) + -- "Transform.ag"(line 655, column 8) + _elemsOdefinedSets = + ({-# LINE 655 "Transform.ag" #-} + Map.map fst _elemsIdefSets + {-# LINE 881 "Transform.hs" #-} + ) + -- "Transform.ag"(line 937, column 8) + _elemsOattrDecls = + ({-# LINE 937 "Transform.ag" #-} + Map.empty + {-# LINE 887 "Transform.hs" #-} + ) + -- "Transform.ag"(line 990, column 9) + _allAttrDecls = + ({-# LINE 990 "Transform.ag" #-} + if withSelf _lhsIoptions + then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals ) + else _elemsIattrDecls + {-# LINE 895 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + _elemsIblocks + {-# LINE 901 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + _elemsImoduleDecl + {-# LINE 907 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + _elemsIpragmas + {-# LINE 913 "Transform.hs" #-} + ) + -- copy rule (from local) + _elemsOallAttrDecls = + ({-# LINE 822 "Transform.ag" #-} + _allAttrDecls + {-# LINE 919 "Transform.hs" #-} + ) + -- copy rule (from local) + _elemsOallFields = + ({-# LINE 129 "Transform.ag" #-} + _allFields + {-# LINE 925 "Transform.hs" #-} + ) + -- copy rule (from local) + _elemsOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _allNonterminals + {-# LINE 931 "Transform.hs" #-} + ) + -- copy rule (down) + _elemsOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 937 "Transform.hs" #-} + ) + ( _elemsIattrDecls,_elemsIattrOrderCollect,_elemsIblocks,_elemsIcollectedArounds,_elemsIcollectedAugments,_elemsIcollectedConstructorsMap,_elemsIcollectedFields,_elemsIcollectedInsts,_elemsIcollectedMerges,_elemsIcollectedNames,_elemsIcollectedRules,_elemsIcollectedSetNames,_elemsIcollectedSigs,_elemsIcollectedUniques,_elemsIctxCollect,_elemsIdefSets,_elemsIderivings,_elemsIerrors,_elemsImoduleDecl,_elemsIparamsCollect,_elemsIpragmas,_elemsIquantCollect,_elemsIsemPragmasCollect,_elemsItypeSyns,_elemsIuseMap,_elemsIwrappers) = + elems_ _elemsOallAttrDecls _elemsOallConstructors _elemsOallFields _elemsOallNonterminals _elemsOattrDecls _elemsOdefSets _elemsOdefinedSets _elemsOoptions + in ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas))) ) +-- Alt --------------------------------------------------------- +{- + visit 0: + inherited attributes: + allConstructors : Map NontermIdent (Set ConstructorIdent) + allNonterminals : Set NontermIdent + nts : Set NontermIdent + synthesized attributes: + collectedConstructorNames : Set ConstructorIdent + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + alternatives: + alternative Alt: + child pos : {Pos} + child names : ConstructorSet + child fields : {Fields} +-} +-- cata +sem_Alt :: Alt -> + T_Alt +sem_Alt (Alt _pos _names _fields ) = + (sem_Alt_Alt _pos (sem_ConstructorSet _names ) _fields ) +-- semantic domain +newtype T_Alt = T_Alt ((Map NontermIdent (Set ConstructorIdent)) -> + (Set NontermIdent) -> + (Set NontermIdent) -> + ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]))) +data Inh_Alt = Inh_Alt {allConstructors_Inh_Alt :: !((Map NontermIdent (Set ConstructorIdent))),allNonterminals_Inh_Alt :: !((Set NontermIdent)),nts_Inh_Alt :: !((Set NontermIdent))} +data Syn_Alt = Syn_Alt {collectedConstructorNames_Syn_Alt :: !((Set ConstructorIdent)),collectedFields_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, FieldMap)]))} +wrap_Alt :: T_Alt -> + Inh_Alt -> + Syn_Alt +wrap_Alt (T_Alt sem ) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts ) = + (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) = sem _lhsIallConstructors _lhsIallNonterminals _lhsInts + in (Syn_Alt _lhsOcollectedConstructorNames _lhsOcollectedFields )) +sem_Alt_Alt :: Pos -> + T_ConstructorSet -> + Fields -> + T_Alt +sem_Alt_Alt pos_ (T_ConstructorSet names_ ) fields_ = + (T_Alt (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _namesIcollectedConstructorNames :: (Set ConstructorIdent) + _namesIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _namesIerrors :: (Seq Error) + -- "Transform.ag"(line 239, column 10) + _lhsOcollectedFields = + ({-# LINE 239 "Transform.ag" #-} + let fieldTable = + [ (attr, makeType _lhsIallNonterminals tp) + | (attr, tp) <- fields_ + ] + in [ (nt, con, fieldTable) + | nt <- Set.toList _lhsInts + , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) + ] + {-# LINE 1000 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 94, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 94 "Transform.ag" #-} + _namesIcollectedConstructorNames + {-# LINE 1006 "Transform.hs" #-} + ) + ( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) = + names_ + in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))) ) +-- Alts -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allConstructors : Map NontermIdent (Set ConstructorIdent) + allNonterminals : Set NontermIdent + nts : Set NontermIdent + synthesized attributes: + collectedConstructorNames : Set ConstructorIdent + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + alternatives: + alternative Cons: + child hd : Alt + child tl : Alts + alternative Nil: +-} +-- cata +sem_Alts :: Alts -> + T_Alts +sem_Alts list = + (Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list) ) +-- semantic domain +newtype T_Alts = T_Alts ((Map NontermIdent (Set ConstructorIdent)) -> + (Set NontermIdent) -> + (Set NontermIdent) -> + ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]))) +data Inh_Alts = Inh_Alts {allConstructors_Inh_Alts :: !((Map NontermIdent (Set ConstructorIdent))),allNonterminals_Inh_Alts :: !((Set NontermIdent)),nts_Inh_Alts :: !((Set NontermIdent))} +data Syn_Alts = Syn_Alts {collectedConstructorNames_Syn_Alts :: !((Set ConstructorIdent)),collectedFields_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, FieldMap)]))} +wrap_Alts :: T_Alts -> + Inh_Alts -> + Syn_Alts +wrap_Alts (T_Alts sem ) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts ) = + (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) = sem _lhsIallConstructors _lhsIallNonterminals _lhsInts + in (Syn_Alts _lhsOcollectedConstructorNames _lhsOcollectedFields )) +sem_Alts_Cons :: T_Alt -> + T_Alts -> + T_Alts +sem_Alts_Cons (T_Alt hd_ ) (T_Alts tl_ ) = + (T_Alts (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _hdOallNonterminals :: (Set NontermIdent) + _hdOnts :: (Set NontermIdent) + _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _tlOallNonterminals :: (Set NontermIdent) + _tlOnts :: (Set NontermIdent) + _hdIcollectedConstructorNames :: (Set ConstructorIdent) + _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _tlIcollectedConstructorNames :: (Set ConstructorIdent) + _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + -- use rule "Transform.ag"(line 94, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 94 "Transform.ag" #-} + _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames + {-# LINE 1068 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + _hdIcollectedFields ++ _tlIcollectedFields + {-# LINE 1074 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOallConstructors = + ({-# LINE 97 "Transform.ag" #-} + _lhsIallConstructors + {-# LINE 1080 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 1086 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOnts = + ({-# LINE 168 "Transform.ag" #-} + _lhsInts + {-# LINE 1092 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOallConstructors = + ({-# LINE 97 "Transform.ag" #-} + _lhsIallConstructors + {-# LINE 1098 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 1104 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOnts = + ({-# LINE 168 "Transform.ag" #-} + _lhsInts + {-# LINE 1110 "Transform.hs" #-} + ) + ( _hdIcollectedConstructorNames,_hdIcollectedFields) = + hd_ _hdOallConstructors _hdOallNonterminals _hdOnts + ( _tlIcollectedConstructorNames,_tlIcollectedFields) = + tl_ _tlOallConstructors _tlOallNonterminals _tlOnts + in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))) ) +sem_Alts_Nil :: T_Alts +sem_Alts_Nil = + (T_Alts (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + -- use rule "Transform.ag"(line 94, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 94 "Transform.ag" #-} + Set.empty + {-# LINE 1128 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 1134 "Transform.hs" #-} + ) + in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))) ) +-- Attrs ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allFields : DataTypes + allNonterminals : Set NontermIdent + nts : Set NontermIdent + options : Options + chained attribute: + attrDecls : Map NontermIdent (Attributes, Attributes) + synthesized attributes: + errors : Seq Error + useMap : Map NontermIdent (Map Identifier (String,String,String)) + alternatives: + alternative Attrs: + child pos : {Pos} + child inh : {AttrNames} + child chn : {AttrNames} + child syn : {AttrNames} + visit 0: + local _tup1 : _ + local attrDecls : _ + local errors : _ + local _tup2 : _ + local inherited : _ + local synthesized : _ + local useMap : _ + local errors1 : _ +-} +-- cata +sem_Attrs :: Attrs -> + T_Attrs +sem_Attrs (Attrs _pos _inh _chn _syn ) = + (sem_Attrs_Attrs _pos _inh _chn _syn ) +-- semantic domain +newtype T_Attrs = T_Attrs (DataTypes -> + (Set NontermIdent) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Set NontermIdent) -> + Options -> + ( (Map NontermIdent (Attributes, Attributes)),(Seq Error),(Map NontermIdent (Map Identifier (String,String,String))))) +data Inh_Attrs = Inh_Attrs {allFields_Inh_Attrs :: !(DataTypes),allNonterminals_Inh_Attrs :: !((Set NontermIdent)),attrDecls_Inh_Attrs :: !((Map NontermIdent (Attributes, Attributes))),nts_Inh_Attrs :: !((Set NontermIdent)),options_Inh_Attrs :: !(Options)} +data Syn_Attrs = Syn_Attrs {attrDecls_Syn_Attrs :: !((Map NontermIdent (Attributes, Attributes))),errors_Syn_Attrs :: !((Seq Error)),useMap_Syn_Attrs :: !((Map NontermIdent (Map Identifier (String,String,String))))} +wrap_Attrs :: T_Attrs -> + Inh_Attrs -> + Syn_Attrs +wrap_Attrs (T_Attrs sem ) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts _lhsIoptions ) = + (let ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap) = sem _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts _lhsIoptions + in (Syn_Attrs _lhsOattrDecls _lhsOerrors _lhsOuseMap )) +sem_Attrs_Attrs :: Pos -> + AttrNames -> + AttrNames -> + AttrNames -> + T_Attrs +sem_Attrs_Attrs pos_ inh_ chn_ syn_ = + (T_Attrs (\ _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsInts + _lhsIoptions -> + (let _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOerrors :: (Seq Error) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + -- "Transform.ag"(line 945, column 15) + __tup1 = + ({-# LINE 945 "Transform.ag" #-} + checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls + {-# LINE 1204 "Transform.hs" #-} + ) + -- "Transform.ag"(line 945, column 15) + (_attrDecls,_) = + ({-# LINE 945 "Transform.ag" #-} + __tup1 + {-# LINE 1210 "Transform.hs" #-} + ) + -- "Transform.ag"(line 945, column 15) + (_,_errors) = + ({-# LINE 945 "Transform.ag" #-} + __tup1 + {-# LINE 1216 "Transform.hs" #-} + ) + -- "Transform.ag"(line 947, column 15) + __tup2 = + ({-# LINE 947 "Transform.ag" #-} + let splitAttrs xs = unzip [ ((n,makeType _lhsIallNonterminals t),(n,ud)) + | (n,t,ud) <- xs + ] + (inh,_) = splitAttrs inh_ + (chn,uses1) = splitAttrs chn_ + (syn,uses2) = splitAttrs syn_ + isUse (n,(e1,e2,_)) = not (null e1 || null e2) + in (inh++chn,chn++syn, Map.fromList (Prelude.filter isUse (uses1++uses2))) + {-# LINE 1229 "Transform.hs" #-} + ) + -- "Transform.ag"(line 947, column 15) + (_inherited,_,_) = + ({-# LINE 947 "Transform.ag" #-} + __tup2 + {-# LINE 1235 "Transform.hs" #-} + ) + -- "Transform.ag"(line 947, column 15) + (_,_synthesized,_) = + ({-# LINE 947 "Transform.ag" #-} + __tup2 + {-# LINE 1241 "Transform.hs" #-} + ) + -- "Transform.ag"(line 947, column 15) + (_,_,_useMap) = + ({-# LINE 947 "Transform.ag" #-} + __tup2 + {-# LINE 1247 "Transform.hs" #-} + ) + -- "Transform.ag"(line 955, column 11) + _lhsOuseMap = + ({-# LINE 955 "Transform.ag" #-} + Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap)) + {-# LINE 1253 "Transform.hs" #-} + ) + -- "Transform.ag"(line 957, column 11) + _errors1 = + ({-# LINE 957 "Transform.ag" #-} + if checkParseTy _lhsIoptions + then let attrs = inh_ ++ syn_ ++ chn_ + items = map (\(ident,tp,_) -> (getPos ident, tp)) attrs + errs = map check items + check (pos,Haskell s) = + let exp = Expression pos tks + tks = [tk] + tk = HsToken s pos + in Seq.fromList $ checkTy exp + check _ = Seq.empty + in foldr (Seq.><) Seq.empty errs + else Seq.empty + {-# LINE 1270 "Transform.hs" #-} + ) + -- "Transform.ag"(line 969, column 11) + _lhsOerrors = + ({-# LINE 969 "Transform.ag" #-} + _errors Seq.>< _errors1 + {-# LINE 1276 "Transform.hs" #-} + ) + -- copy rule (from local) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _attrDecls + {-# LINE 1282 "Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap))) ) +-- ConstructorSet ---------------------------------------------- +{- + visit 0: + synthesized attributes: + collectedConstructorNames : Set ConstructorIdent + constructors : (Set ConstructorIdent->Set ConstructorIdent) + errors : Seq Error + alternatives: + alternative CAll: + alternative CDifference: + child set1 : ConstructorSet + child set2 : ConstructorSet + alternative CName: + child name : {ConstructorIdent} + alternative CUnion: + child set1 : ConstructorSet + child set2 : ConstructorSet +-} +-- cata +sem_ConstructorSet :: ConstructorSet -> + T_ConstructorSet +sem_ConstructorSet (CAll ) = + (sem_ConstructorSet_CAll ) +sem_ConstructorSet (CDifference _set1 _set2 ) = + (sem_ConstructorSet_CDifference (sem_ConstructorSet _set1 ) (sem_ConstructorSet _set2 ) ) +sem_ConstructorSet (CName _name ) = + (sem_ConstructorSet_CName _name ) +sem_ConstructorSet (CUnion _set1 _set2 ) = + (sem_ConstructorSet_CUnion (sem_ConstructorSet _set1 ) (sem_ConstructorSet _set2 ) ) +-- semantic domain +newtype T_ConstructorSet = T_ConstructorSet (( (Set ConstructorIdent),((Set ConstructorIdent->Set ConstructorIdent)),(Seq Error))) +data Inh_ConstructorSet = Inh_ConstructorSet {} +data Syn_ConstructorSet = Syn_ConstructorSet {collectedConstructorNames_Syn_ConstructorSet :: !((Set ConstructorIdent)),constructors_Syn_ConstructorSet :: !(((Set ConstructorIdent->Set ConstructorIdent))),errors_Syn_ConstructorSet :: !((Seq Error))} +wrap_ConstructorSet :: T_ConstructorSet -> + Inh_ConstructorSet -> + Syn_ConstructorSet +wrap_ConstructorSet (T_ConstructorSet sem ) (Inh_ConstructorSet ) = + (let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) = sem + in (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors )) +sem_ConstructorSet_CAll :: T_ConstructorSet +sem_ConstructorSet_CAll = + (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOerrors :: (Seq Error) + -- "Transform.ag"(line 725, column 17) + _lhsOconstructors = + ({-# LINE 725 "Transform.ag" #-} + \ds -> ds + {-# LINE 1333 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 94, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 94 "Transform.ag" #-} + Set.empty + {-# LINE 1339 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 1345 "Transform.hs" #-} + ) + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)) ) +sem_ConstructorSet_CDifference :: T_ConstructorSet -> + T_ConstructorSet -> + T_ConstructorSet +sem_ConstructorSet_CDifference (T_ConstructorSet set1_ ) (T_ConstructorSet set2_ ) = + (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOerrors :: (Seq Error) + _set1IcollectedConstructorNames :: (Set ConstructorIdent) + _set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _set1Ierrors :: (Seq Error) + _set2IcollectedConstructorNames :: (Set ConstructorIdent) + _set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _set2Ierrors :: (Seq Error) + -- "Transform.ag"(line 724, column 17) + _lhsOconstructors = + ({-# LINE 724 "Transform.ag" #-} + \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds + {-# LINE 1365 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 94, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 94 "Transform.ag" #-} + _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames + {-# LINE 1371 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 1377 "Transform.hs" #-} + ) + ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = + set1_ + ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = + set2_ + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)) ) +sem_ConstructorSet_CName :: ConstructorIdent -> + T_ConstructorSet +sem_ConstructorSet_CName name_ = + (T_ConstructorSet (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _lhsOerrors :: (Seq Error) + -- "Transform.ag"(line 569, column 11) + _lhsOcollectedConstructorNames = + ({-# LINE 569 "Transform.ag" #-} + Set.singleton name_ + {-# LINE 1394 "Transform.hs" #-} + ) + -- "Transform.ag"(line 722, column 17) + _lhsOconstructors = + ({-# LINE 722 "Transform.ag" #-} + \ds -> Set.singleton name_ + {-# LINE 1400 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 1406 "Transform.hs" #-} + ) + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)) ) +sem_ConstructorSet_CUnion :: T_ConstructorSet -> + T_ConstructorSet -> + T_ConstructorSet +sem_ConstructorSet_CUnion (T_ConstructorSet set1_ ) (T_ConstructorSet set2_ ) = + (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOerrors :: (Seq Error) + _set1IcollectedConstructorNames :: (Set ConstructorIdent) + _set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _set1Ierrors :: (Seq Error) + _set2IcollectedConstructorNames :: (Set ConstructorIdent) + _set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _set2Ierrors :: (Seq Error) + -- "Transform.ag"(line 723, column 17) + _lhsOconstructors = + ({-# LINE 723 "Transform.ag" #-} + \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds + {-# LINE 1426 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 94, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 94 "Transform.ag" #-} + _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames + {-# LINE 1432 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 1438 "Transform.hs" #-} + ) + ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = + set1_ + ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = + set2_ + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)) ) +-- Elem -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allConstructors : Map NontermIdent (Set ConstructorIdent) + allFields : DataTypes + allNonterminals : Set NontermIdent + definedSets : DefinedSets + options : Options + chained attributes: + attrDecls : Map NontermIdent (Attributes, Attributes) + defSets : Map Identifier (Set NontermIdent,Set Identifier) + synthesized attributes: + attrOrderCollect : AttrOrderMap + blocks : Blocks + collectedArounds : [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] + collectedAugments : [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] + collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedMerges : [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] + collectedNames : Set Identifier + collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] + collectedSetNames : Set Identifier + collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] + collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] + ctxCollect : ContextMap + derivings : Derivings + errors : Seq Error + moduleDecl : Maybe (String,String,String) + paramsCollect : ParamMap + pragmas : Options -> Options + quantCollect : QuantMap + semPragmasCollect : PragmaMap + typeSyns : TypeSyns + useMap : Map NontermIdent (Map Identifier (String,String,String)) + wrappers : Set NontermIdent + alternatives: + alternative Attr: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child quants : {[String]} + child attrs : Attrs + alternative Data: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child params : {[Identifier]} + child attrs : Attrs + child alts : Alts + child ext : {Bool} + alternative Deriving: + child pos : {Pos} + child set : NontSet + child classes : {[NontermIdent]} + alternative Module: + child pos : {Pos} + child name : {String} + child exports : {String} + child imports : {String} + alternative Nocatas: + child pos : {Pos} + child set : NontSet + alternative Pragma: + child pos : {Pos} + child names : {[NontermIdent]} + alternative Sem: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child attrs : Attrs + child quants : {[String]} + child alts : SemAlts + alternative Set: + child pos : {Pos} + child name : {NontermIdent} + child merge : {Bool} + child set : NontSet + visit 0: + local _tup3 : _ + local defSets2 : _ + local errs : _ + alternative Txt: + child pos : {Pos} + child name : {Identifier} + child mbNt : {Maybe NontermIdent} + child lines : {[String]} + visit 0: + local blockInfo : _ + local blockValue : _ + alternative Type: + child pos : {Pos} + child ctx : {ClassContext} + child name : {NontermIdent} + child params : {[Identifier]} + child type : {ComplexType} + visit 0: + local expanded : _ + local argType : _ + alternative Wrapper: + child pos : {Pos} + child set : NontSet +-} +-- cata +sem_Elem :: Elem -> + T_Elem +sem_Elem (Attr _pos _ctx _names _quants _attrs ) = + (sem_Elem_Attr _pos _ctx (sem_NontSet _names ) _quants (sem_Attrs _attrs ) ) +sem_Elem (Data _pos _ctx _names _params _attrs _alts _ext ) = + (sem_Elem_Data _pos _ctx (sem_NontSet _names ) _params (sem_Attrs _attrs ) (sem_Alts _alts ) _ext ) +sem_Elem (Deriving _pos _set _classes ) = + (sem_Elem_Deriving _pos (sem_NontSet _set ) _classes ) +sem_Elem (Module _pos _name _exports _imports ) = + (sem_Elem_Module _pos _name _exports _imports ) +sem_Elem (Nocatas _pos _set ) = + (sem_Elem_Nocatas _pos (sem_NontSet _set ) ) +sem_Elem (Pragma _pos _names ) = + (sem_Elem_Pragma _pos _names ) +sem_Elem (Sem _pos _ctx _names _attrs _quants _alts ) = + (sem_Elem_Sem _pos _ctx (sem_NontSet _names ) (sem_Attrs _attrs ) _quants (sem_SemAlts _alts ) ) +sem_Elem (Set _pos _name _merge _set ) = + (sem_Elem_Set _pos _name _merge (sem_NontSet _set ) ) +sem_Elem (Txt _pos _name _mbNt _lines ) = + (sem_Elem_Txt _pos _name _mbNt _lines ) +sem_Elem (Type _pos _ctx _name _params _type ) = + (sem_Elem_Type _pos _ctx _name _params _type ) +sem_Elem (Wrapper _pos _set ) = + (sem_Elem_Wrapper _pos (sem_NontSet _set ) ) +-- semantic domain +newtype T_Elem = T_Elem ((Map NontermIdent (Attributes, Attributes)) -> + (Map NontermIdent (Set ConstructorIdent)) -> + DataTypes -> + (Set NontermIdent) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map Identifier (Set NontermIdent,Set Identifier)) -> + DefinedSets -> + Options -> + ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,Blocks,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),QuantMap,PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent))) +data Inh_Elem = Inh_Elem {allAttrDecls_Inh_Elem :: !((Map NontermIdent (Attributes, Attributes))),allConstructors_Inh_Elem :: !((Map NontermIdent (Set ConstructorIdent))),allFields_Inh_Elem :: !(DataTypes),allNonterminals_Inh_Elem :: !((Set NontermIdent)),attrDecls_Inh_Elem :: !((Map NontermIdent (Attributes, Attributes))),defSets_Inh_Elem :: !((Map Identifier (Set NontermIdent,Set Identifier))),definedSets_Inh_Elem :: !(DefinedSets),options_Inh_Elem :: !(Options)} +data Syn_Elem = Syn_Elem {attrDecls_Syn_Elem :: !((Map NontermIdent (Attributes, Attributes))),attrOrderCollect_Syn_Elem :: !(AttrOrderMap),blocks_Syn_Elem :: !(Blocks),collectedArounds_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedConstructorsMap_Syn_Elem :: !((Map NontermIdent (Set ConstructorIdent))),collectedFields_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedInsts_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMerges_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),collectedNames_Syn_Elem :: !((Set Identifier)),collectedRules_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, RuleInfo)])),collectedSetNames_Syn_Elem :: !((Set Identifier)),collectedSigs_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, SigInfo) ])),collectedUniques_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])),ctxCollect_Syn_Elem :: !(ContextMap),defSets_Syn_Elem :: !((Map Identifier (Set NontermIdent,Set Identifier))),derivings_Syn_Elem :: !(Derivings),errors_Syn_Elem :: !((Seq Error)),moduleDecl_Syn_Elem :: !((Maybe (String,String,String))),paramsCollect_Syn_Elem :: !(ParamMap),pragmas_Syn_Elem :: !((Options -> Options)),quantCollect_Syn_Elem :: !(QuantMap),semPragmasCollect_Syn_Elem :: !(PragmaMap),typeSyns_Syn_Elem :: !(TypeSyns),useMap_Syn_Elem :: !((Map NontermIdent (Map Identifier (String,String,String)))),wrappers_Syn_Elem :: !((Set NontermIdent))} +wrap_Elem :: T_Elem -> + Inh_Elem -> + Syn_Elem +wrap_Elem (T_Elem sem ) (Inh_Elem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets _lhsIoptions ) = + (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets _lhsIoptions + in (Syn_Elem _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers )) +sem_Elem_Attr :: Pos -> + ClassContext -> + T_NontSet -> + ([String]) -> + T_Attrs -> + T_Elem +sem_Elem_Attr pos_ ctx_ (T_NontSet names_ ) quants_ (T_Attrs attrs_ ) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOctxCollect :: ContextMap + _lhsOquantCollect :: QuantMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _namesOallFields :: DataTypes + _namesOallNonterminals :: (Set NontermIdent) + _namesOdefinedSets :: DefinedSets + _attrsOallFields :: DataTypes + _attrsOallNonterminals :: (Set NontermIdent) + _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsOoptions :: Options + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + -- "Transform.ag"(line 880, column 7) + _lhsOctxCollect = + ({-# LINE 880 "Transform.ag" #-} + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + {-# LINE 1654 "Transform.hs" #-} + ) + -- "Transform.ag"(line 905, column 7) + _lhsOquantCollect = + ({-# LINE 905 "Transform.ag" #-} + if null quants_ + then Map.empty + else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] + {-# LINE 1662 "Transform.hs" #-} + ) + -- "Transform.ag"(line 941, column 10) + _attrsOnts = + ({-# LINE 941 "Transform.ag" #-} + _namesInontSet + {-# LINE 1668 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 1674 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 1680 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 1686 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 1692 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 1698 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 1704 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 1710 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 1716 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _namesIcollectedNames + {-# LINE 1722 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 1728 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 1734 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 1740 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 1746 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 1752 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _namesIerrors Seq.>< _attrsIerrors + {-# LINE 1758 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 1764 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 1770 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 1776 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 1782 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 1788 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + _attrsIuseMap + {-# LINE 1794 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 1800 "Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _attrsIattrDecls + {-# LINE 1806 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 1812 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 1818 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 1824 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 1830 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 1836 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 1842 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 1848 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 1854 "Transform.hs" #-} + ) + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets + ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = + attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts _attrsOoptions + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Data :: Pos -> + ClassContext -> + T_NontSet -> + ([Identifier]) -> + T_Attrs -> + T_Alts -> + Bool -> + T_Elem +sem_Elem_Data pos_ ctx_ (T_NontSet names_ ) params_ (T_Attrs attrs_ ) (T_Alts alts_ ) ext_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _altsOnts :: (Set NontermIdent) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOparamsCollect :: ParamMap + _lhsOctxCollect :: ContextMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _namesOallFields :: DataTypes + _namesOallNonterminals :: (Set NontermIdent) + _namesOdefinedSets :: DefinedSets + _attrsOallFields :: DataTypes + _attrsOallNonterminals :: (Set NontermIdent) + _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsOoptions :: Options + _altsOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _altsOallNonterminals :: (Set NontermIdent) + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _altsIcollectedConstructorNames :: (Set ConstructorIdent) + _altsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + -- "Transform.ag"(line 171, column 10) + _altsOnts = + ({-# LINE 171 "Transform.ag" #-} + _namesInontSet + {-# LINE 1927 "Transform.hs" #-} + ) + -- "Transform.ag"(line 575, column 11) + _lhsOcollectedConstructorsMap = + ({-# LINE 575 "Transform.ag" #-} + Map.fromList + [ (n, _altsIcollectedConstructorNames) + | n <- Set.toList _namesInontSet + ] + {-# LINE 1936 "Transform.hs" #-} + ) + -- "Transform.ag"(line 857, column 7) + _lhsOparamsCollect = + ({-# LINE 857 "Transform.ag" #-} + if null params_ + then Map.empty + else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet] + {-# LINE 1944 "Transform.hs" #-} + ) + -- "Transform.ag"(line 880, column 7) + _lhsOctxCollect = + ({-# LINE 880 "Transform.ag" #-} + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + {-# LINE 1952 "Transform.hs" #-} + ) + -- "Transform.ag"(line 940, column 10) + _attrsOnts = + ({-# LINE 940 "Transform.ag" #-} + _namesInontSet + {-# LINE 1958 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 1964 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 1970 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 1976 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 1982 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + _altsIcollectedFields + {-# LINE 1988 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 1994 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 2000 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _namesIcollectedNames + {-# LINE 2006 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 2012 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 2018 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 2024 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 2030 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 2036 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _namesIerrors Seq.>< _attrsIerrors + {-# LINE 2042 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 2048 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 2054 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 2060 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 2066 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 2072 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + _attrsIuseMap + {-# LINE 2078 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 2084 "Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _attrsIattrDecls + {-# LINE 2090 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 2096 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 2102 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2108 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 2114 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 2120 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2126 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 2132 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 2138 "Transform.hs" #-} + ) + -- copy rule (down) + _altsOallConstructors = + ({-# LINE 97 "Transform.ag" #-} + _lhsIallConstructors + {-# LINE 2144 "Transform.hs" #-} + ) + -- copy rule (down) + _altsOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2150 "Transform.hs" #-} + ) + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets + ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = + attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts _attrsOoptions + ( _altsIcollectedConstructorNames,_altsIcollectedFields) = + alts_ _altsOallConstructors _altsOallNonterminals _altsOnts + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Deriving :: Pos -> + T_NontSet -> + ([NontermIdent]) -> + T_Elem +sem_Elem_Deriving pos_ (T_NontSet set_ ) classes_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOderivings :: Derivings + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _setOallFields :: DataTypes + _setOallNonterminals :: (Set NontermIdent) + _setOdefinedSets :: DefinedSets + _setIcollectedNames :: (Set Identifier) + _setIerrors :: (Seq Error) + _setInontSet :: (Set NontermIdent) + -- "Transform.ag"(line 925, column 14) + _lhsOderivings = + ({-# LINE 925 "Transform.ag" #-} + Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] + {-# LINE 2208 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 2214 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 2220 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 2226 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 2232 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 2238 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 2244 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 2250 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 2256 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _setIcollectedNames + {-# LINE 2262 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 2268 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 2274 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 2280 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 2286 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + Map.empty + {-# LINE 2292 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _setIerrors + {-# LINE 2298 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 2304 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 2310 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 2316 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 2322 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 2328 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 2334 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 2340 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 2346 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 2352 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 2358 "Transform.hs" #-} + ) + -- copy rule (down) + _setOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 2364 "Transform.hs" #-} + ) + -- copy rule (down) + _setOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2370 "Transform.hs" #-} + ) + -- copy rule (down) + _setOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 2376 "Transform.hs" #-} + ) + ( _setIcollectedNames,_setIerrors,_setInontSet) = + set_ _setOallFields _setOallNonterminals _setOdefinedSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Module :: Pos -> + String -> + String -> + String -> + T_Elem +sem_Elem_Module pos_ name_ exports_ imports_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "Transform.ag"(line 1118, column 7) + _lhsOmoduleDecl = + ({-# LINE 1118 "Transform.ag" #-} + Just (name_, exports_, imports_) + {-# LINE 2425 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 2431 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 2437 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 2443 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 2449 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 2455 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 2461 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 2467 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 2473 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + Set.empty + {-# LINE 2479 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 2485 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 2491 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 2497 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 2503 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + Map.empty + {-# LINE 2509 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 2515 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 2521 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 2527 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 2533 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 2539 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 2545 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 2551 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 2557 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 2563 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 2569 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 2575 "Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Nocatas :: Pos -> + T_NontSet -> + T_Elem +sem_Elem_Nocatas pos_ (T_NontSet set_ ) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOpragmas :: (Options -> Options) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _setOallFields :: DataTypes + _setOallNonterminals :: (Set NontermIdent) + _setOdefinedSets :: DefinedSets + _setIcollectedNames :: (Set Identifier) + _setIerrors :: (Seq Error) + _setInontSet :: (Set NontermIdent) + -- "Transform.ag"(line 741, column 14) + _lhsOpragmas = + ({-# LINE 741 "Transform.ag" #-} + \o -> o { nocatas = _setInontSet `Set.union` nocatas o } + {-# LINE 2626 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 2632 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 2638 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 2644 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 2650 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 2656 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 2662 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 2668 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 2674 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _setIcollectedNames + {-# LINE 2680 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 2686 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 2692 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 2698 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 2704 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + Map.empty + {-# LINE 2710 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 2716 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _setIerrors + {-# LINE 2722 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 2728 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 2734 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 2740 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 2746 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 2752 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 2758 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 2764 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 2770 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 2776 "Transform.hs" #-} + ) + -- copy rule (down) + _setOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 2782 "Transform.hs" #-} + ) + -- copy rule (down) + _setOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2788 "Transform.hs" #-} + ) + -- copy rule (down) + _setOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 2794 "Transform.hs" #-} + ) + ( _setIcollectedNames,_setIerrors,_setInontSet) = + set_ _setOallFields _setOallNonterminals _setOdefinedSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Pragma :: Pos -> + ([NontermIdent]) -> + T_Elem +sem_Elem_Pragma pos_ names_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOpragmas :: (Options -> Options) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "Transform.ag"(line 750, column 13) + _lhsOpragmas = + ({-# LINE 750 "Transform.ag" #-} + let mk n o = case getName n of + "gencatas" -> o { folds = True } + "nogencatas" -> o { folds = False } + "gendatas" -> o { dataTypes = True } + "nogendatas" -> o { dataTypes = False } + "gensems" -> o { semfuns = True } + "nogensems" -> o { semfuns = False } + "gentypesigs" -> o { typeSigs = True } + "nogentypesigs"-> o { typeSigs = False } + "nocycle" -> o { withCycle = False } + "cycle" -> o { withCycle = True } + "nostrictdata" -> o { strictData = False } + "strictdata" -> o { strictData = True } + "nostrictcase" -> o { strictCases = False } + "strictcase" -> o { strictCases = True } + "strictercase" -> o { strictCases = True, stricterCases = True } + "nostrictwrap" -> o { strictWrap = False } + "strictwrap" -> o { strictWrap = True } + "novisit" -> o { visit = False } + "visit" -> o { visit = True } + "nocase" -> o { cases = False } + "case" -> o { cases = True } + "noseq" -> o { withSeq = False } + "seq" -> o { withSeq = True } + "nounbox" -> o { unbox = False } + "unbox" -> o { unbox = True } + "bangpats" -> o { bangpats = True } + "breadthfirst" -> o { breadthFirst = True } + "breadthfirstStrict" -> o { breadthFirstStrict = True } + "nooptimize" -> o { cases = False , visit = False } + "optimize" -> o { cases = True , visit = True } + "strictsem" -> o { strictSems = True } + "gentraces" -> o { genTraces = True } + "genusetraces" -> o { genUseTraces = True } + "splitsems" -> o { splitSems = True } + "gencostcentres" -> o { genCostCentres = True } + "sepsemmods" -> o { sepSemMods = True } + "genlinepragmas" -> o { genLinePragmas = True } + "newtypes" -> o { newtypes = True } + "nonewtypes" -> o { newtypes = False } + _ -> o + in \o -> foldr mk o names_ + {-# LINE 2882 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 2888 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 2894 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 2900 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 2906 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 2912 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 2918 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 2924 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 2930 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + Set.empty + {-# LINE 2936 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 2942 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 2948 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 2954 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 2960 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + Map.empty + {-# LINE 2966 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 2972 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 2978 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 2984 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 2990 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 2996 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 3002 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 3008 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 3014 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 3020 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 3026 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 3032 "Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Sem :: Pos -> + ClassContext -> + T_NontSet -> + T_Attrs -> + ([String]) -> + T_SemAlts -> + T_Elem +sem_Elem_Sem pos_ ctx_ (T_NontSet names_ ) (T_Attrs attrs_ ) quants_ (T_SemAlts alts_ ) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _altsOnts :: (Set NontermIdent) + _lhsOctxCollect :: ContextMap + _lhsOquantCollect :: QuantMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _namesOallFields :: DataTypes + _namesOallNonterminals :: (Set NontermIdent) + _namesOdefinedSets :: DefinedSets + _attrsOallFields :: DataTypes + _attrsOallNonterminals :: (Set NontermIdent) + _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsOoptions :: Options + _altsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _altsOallFields :: DataTypes + _altsOoptions :: Options + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _altsIattrOrderCollect :: AttrOrderMap + _altsIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _altsIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _altsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _altsIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _altsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _altsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _altsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _altsIerrors :: (Seq Error) + _altsIsemPragmasCollect :: PragmaMap + -- "Transform.ag"(line 172, column 10) + _altsOnts = + ({-# LINE 172 "Transform.ag" #-} + _namesInontSet + {-# LINE 3109 "Transform.hs" #-} + ) + -- "Transform.ag"(line 880, column 7) + _lhsOctxCollect = + ({-# LINE 880 "Transform.ag" #-} + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + {-# LINE 3117 "Transform.hs" #-} + ) + -- "Transform.ag"(line 905, column 7) + _lhsOquantCollect = + ({-# LINE 905 "Transform.ag" #-} + if null quants_ + then Map.empty + else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] + {-# LINE 3125 "Transform.hs" #-} + ) + -- "Transform.ag"(line 942, column 10) + _attrsOnts = + ({-# LINE 942 "Transform.ag" #-} + _namesInontSet + {-# LINE 3131 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + _altsIattrOrderCollect + {-# LINE 3137 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 3143 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + _altsIcollectedArounds + {-# LINE 3149 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + _altsIcollectedAugments + {-# LINE 3155 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 3161 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 3167 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + _altsIcollectedInsts + {-# LINE 3173 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + _altsIcollectedMerges + {-# LINE 3179 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _namesIcollectedNames + {-# LINE 3185 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + _altsIcollectedRules + {-# LINE 3191 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 3197 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + _altsIcollectedSigs + {-# LINE 3203 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + _altsIcollectedUniques + {-# LINE 3209 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 3215 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _namesIerrors Seq.>< _attrsIerrors Seq.>< _altsIerrors + {-# LINE 3221 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 3227 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 3233 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 3239 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + _altsIsemPragmasCollect + {-# LINE 3245 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 3251 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + _attrsIuseMap + {-# LINE 3257 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 3263 "Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _attrsIattrDecls + {-# LINE 3269 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 3275 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 3281 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 3287 "Transform.hs" #-} + ) + -- copy rule (down) + _namesOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 3293 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 3299 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 3305 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 3311 "Transform.hs" #-} + ) + -- copy rule (down) + _attrsOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 3317 "Transform.hs" #-} + ) + -- copy rule (down) + _altsOallAttrDecls = + ({-# LINE 822 "Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 3323 "Transform.hs" #-} + ) + -- copy rule (down) + _altsOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 3329 "Transform.hs" #-} + ) + -- copy rule (down) + _altsOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 3335 "Transform.hs" #-} + ) + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets + ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = + attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts _attrsOoptions + ( _altsIattrOrderCollect,_altsIcollectedArounds,_altsIcollectedAugments,_altsIcollectedInsts,_altsIcollectedMerges,_altsIcollectedRules,_altsIcollectedSigs,_altsIcollectedUniques,_altsIerrors,_altsIsemPragmasCollect) = + alts_ _altsOallAttrDecls _altsOallFields _altsOnts _altsOoptions + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Set :: Pos -> + NontermIdent -> + Bool -> + T_NontSet -> + T_Elem +sem_Elem_Set pos_ name_ merge_ (T_NontSet set_ ) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOcollectedSetNames :: (Set Identifier) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _lhsOerrors :: (Seq Error) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _setOallFields :: DataTypes + _setOallNonterminals :: (Set NontermIdent) + _setOdefinedSets :: DefinedSets + _setIcollectedNames :: (Set Identifier) + _setIerrors :: (Seq Error) + _setInontSet :: (Set NontermIdent) + -- "Transform.ag"(line 552, column 10) + _lhsOcollectedSetNames = + ({-# LINE 552 "Transform.ag" #-} + Set.singleton name_ + {-# LINE 3394 "Transform.hs" #-} + ) + -- "Transform.ag"(line 659, column 13) + __tup3 = + ({-# LINE 659 "Transform.ag" #-} + let allUsedNames = Set.unions [ maybe (Set.singleton n) + snd + (Map.lookup n _lhsIdefSets) + | n <- Set.toList _setIcollectedNames + ] + (nontSet,e1) | Set.member name_ allUsedNames + = (Set.empty, Seq.singleton(CyclicSet name_)) + | otherwise = (_setInontSet, Seq.empty) + (res, e2) = let toAdd = (nontSet,Set.insert name_ allUsedNames) + union (a,b) (c,d) = (a `Set.union` c, b `Set.union` d) + in if Set.member name_ _lhsIallNonterminals || not merge_ + then checkDuplicate DupSet name_ toAdd _lhsIdefSets + else (Map.insertWith union name_ toAdd _lhsIdefSets, Seq.empty) + in (res, e1 Seq.>< e2) + {-# LINE 3413 "Transform.hs" #-} + ) + -- "Transform.ag"(line 659, column 13) + (_defSets2,_) = + ({-# LINE 659 "Transform.ag" #-} + __tup3 + {-# LINE 3419 "Transform.hs" #-} + ) + -- "Transform.ag"(line 659, column 13) + (_,_errs) = + ({-# LINE 659 "Transform.ag" #-} + __tup3 + {-# LINE 3425 "Transform.hs" #-} + ) + -- "Transform.ag"(line 673, column 9) + _lhsOdefSets = + ({-# LINE 673 "Transform.ag" #-} + _defSets2 + {-# LINE 3431 "Transform.hs" #-} + ) + -- "Transform.ag"(line 673, column 9) + _lhsOerrors = + ({-# LINE 674 "Transform.ag" #-} + _errs >< _setIerrors + {-# LINE 3437 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 3443 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 3449 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 3455 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 3461 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 3467 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 3473 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 3479 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 3485 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _setIcollectedNames + {-# LINE 3491 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 3497 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 3503 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 3509 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + Map.empty + {-# LINE 3515 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 3521 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 3527 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 3533 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 3539 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 3545 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 3551 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 3557 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 3563 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 3569 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 3575 "Transform.hs" #-} + ) + -- copy rule (down) + _setOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 3581 "Transform.hs" #-} + ) + -- copy rule (down) + _setOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 3587 "Transform.hs" #-} + ) + -- copy rule (down) + _setOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 3593 "Transform.hs" #-} + ) + ( _setIcollectedNames,_setIerrors,_setInontSet) = + set_ _setOallFields _setOallNonterminals _setOdefinedSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Txt :: Pos -> + Identifier -> + (Maybe NontermIdent) -> + ([String]) -> + T_Elem +sem_Elem_Txt pos_ name_ mbNt_ lines_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOblocks :: Blocks + _lhsOerrors :: (Seq Error) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "Transform.ag"(line 181, column 10) + _blockInfo = + ({-# LINE 181 "Transform.ag" #-} + ( let nm = getName name_ + in if nm == "imports" + then BlockImport + else if nm == "optpragmas" + then BlockPragma + else BlockOther + , mbNt_ + ) + {-# LINE 3649 "Transform.hs" #-} + ) + -- "Transform.ag"(line 189, column 10) + _blockValue = + ({-# LINE 189 "Transform.ag" #-} + [(lines_, pos_)] + {-# LINE 3655 "Transform.hs" #-} + ) + -- "Transform.ag"(line 190, column 10) + _lhsOblocks = + ({-# LINE 190 "Transform.ag" #-} + Map.singleton _blockInfo _blockValue + {-# LINE 3661 "Transform.hs" #-} + ) + -- "Transform.ag"(line 191, column 10) + _lhsOerrors = + ({-# LINE 191 "Transform.ag" #-} + if checkParseBlock _lhsIoptions + then let exp = Expression pos_ tks + tks = [tk] + tk = HsToken (unlines lines_) pos_ + in Seq.fromList $ checkBlock $ exp + else Seq.empty + {-# LINE 3672 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 3678 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 3684 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 3690 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 3696 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 3702 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 3708 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 3714 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + Set.empty + {-# LINE 3720 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 3726 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 3732 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 3738 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 3744 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + Map.empty + {-# LINE 3750 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 3756 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 3762 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 3768 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 3774 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 3780 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 3786 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 3792 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 3798 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 3804 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 3810 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 3816 "Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Type :: Pos -> + ClassContext -> + NontermIdent -> + ([Identifier]) -> + ComplexType -> + T_Elem +sem_Elem_Type pos_ ctx_ name_ params_ type_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOtypeSyns :: TypeSyns + _lhsOparamsCollect :: ParamMap + _lhsOctxCollect :: ContextMap + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "Transform.ag"(line 249, column 10) + _lhsOcollectedFields = + ({-# LINE 249 "Transform.ag" #-} + map (\(x,y)->(name_, x, y)) _expanded + {-# LINE 3864 "Transform.hs" #-} + ) + -- "Transform.ag"(line 555, column 11) + _lhsOcollectedNames = + ({-# LINE 555 "Transform.ag" #-} + Set.singleton name_ + {-# LINE 3870 "Transform.hs" #-} + ) + -- "Transform.ag"(line 609, column 11) + _expanded = + ({-# LINE 609 "Transform.ag" #-} + case _argType of + List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp) + ,(Ident "tl" pos_, NT name_ (map getName params_)) + ] + ) + ,(Ident "Nil" pos_, []) + ] + Maybe tp -> [(Ident "Just" pos_, [(Ident "just" pos_, tp) + ] + ) + ,(Ident "Nothing" pos_, []) + ] + Either tp1 tp2 -> [ + (Ident "Left" pos_, [(Ident "left" pos_, tp1) ]) + , (Ident "Right" pos_, [(Ident "right" pos_, tp2) ]) + ] + Map tp1 tp2 -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, tp1) + , (Ident "val" pos_, tp2) + , (Ident "tl" pos_, NT name_ (map getName params_)) + ]) + , (Ident "Nil" pos_, []) + ] + IntMap tp -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, Haskell "Int") + , (Ident "val" pos_, tp) + , (Ident "tl" pos_, NT name_ (map getName params_)) + ]) + , (Ident "Nil" pos_, []) + ] + Tuple xs -> [(Ident "Tuple" pos_, xs)] + {-# LINE 3904 "Transform.hs" #-} + ) + -- "Transform.ag"(line 638, column 11) + _argType = + ({-# LINE 638 "Transform.ag" #-} + case type_ of + Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp) + Either tp1 tp2 -> Either ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2) + List tp -> List ( makeType _lhsIallNonterminals tp) + Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs] + Map tp1 tp2 -> Map ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2) + IntMap tp -> IntMap ( makeType _lhsIallNonterminals tp) + {-# LINE 3916 "Transform.hs" #-} + ) + -- "Transform.ag"(line 645, column 11) + _lhsOtypeSyns = + ({-# LINE 645 "Transform.ag" #-} + [(name_,_argType)] + {-# LINE 3922 "Transform.hs" #-} + ) + -- "Transform.ag"(line 863, column 7) + _lhsOparamsCollect = + ({-# LINE 863 "Transform.ag" #-} + if null params_ + then Map.empty + else Map.singleton name_ params_ + {-# LINE 3930 "Transform.hs" #-} + ) + -- "Transform.ag"(line 886, column 7) + _lhsOctxCollect = + ({-# LINE 886 "Transform.ag" #-} + if null ctx_ + then Map.empty + else Map.singleton name_ ctx_ + {-# LINE 3938 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 3944 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 3950 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 3956 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 3962 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 3968 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 3974 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 3980 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 3986 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 3992 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 3998 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 4004 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 4010 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 4016 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 4022 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 4028 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 4034 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 4040 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 4046 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 4052 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 4058 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 4064 "Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elem_Wrapper :: Pos -> + T_NontSet -> + T_Elem +sem_Elem_Wrapper pos_ (T_NontSet set_ ) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOwrappers :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _setOallFields :: DataTypes + _setOallNonterminals :: (Set NontermIdent) + _setOdefinedSets :: DefinedSets + _setIcollectedNames :: (Set Identifier) + _setIerrors :: (Seq Error) + _setInontSet :: (Set NontermIdent) + -- "Transform.ag"(line 734, column 13) + _lhsOwrappers = + ({-# LINE 734 "Transform.ag" #-} + _setInontSet + {-# LINE 4115 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 4121 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 4127 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 4133 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 4139 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 4145 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 4151 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 4157 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 4163 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _setIcollectedNames + {-# LINE 4169 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 4175 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 4181 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 4187 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 4193 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + Map.empty + {-# LINE 4199 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 4205 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _setIerrors + {-# LINE 4211 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 4217 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 4223 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 4229 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 4235 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 4241 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 4247 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 4253 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 4259 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 4265 "Transform.hs" #-} + ) + -- copy rule (down) + _setOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 4271 "Transform.hs" #-} + ) + -- copy rule (down) + _setOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 4277 "Transform.hs" #-} + ) + -- copy rule (down) + _setOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 4283 "Transform.hs" #-} + ) + ( _setIcollectedNames,_setIerrors,_setInontSet) = + set_ _setOallFields _setOallNonterminals _setOdefinedSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +-- Elems ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allConstructors : Map NontermIdent (Set ConstructorIdent) + allFields : DataTypes + allNonterminals : Set NontermIdent + definedSets : DefinedSets + options : Options + chained attributes: + attrDecls : Map NontermIdent (Attributes, Attributes) + defSets : Map Identifier (Set NontermIdent,Set Identifier) + synthesized attributes: + attrOrderCollect : AttrOrderMap + blocks : Blocks + collectedArounds : [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] + collectedAugments : [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] + collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedMerges : [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] + collectedNames : Set Identifier + collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] + collectedSetNames : Set Identifier + collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] + collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] + ctxCollect : ContextMap + derivings : Derivings + errors : Seq Error + moduleDecl : Maybe (String,String,String) + paramsCollect : ParamMap + pragmas : Options -> Options + quantCollect : QuantMap + semPragmasCollect : PragmaMap + typeSyns : TypeSyns + useMap : Map NontermIdent (Map Identifier (String,String,String)) + wrappers : Set NontermIdent + alternatives: + alternative Cons: + child hd : Elem + child tl : Elems + alternative Nil: +-} +-- cata +sem_Elems :: Elems -> + T_Elems +sem_Elems list = + (Prelude.foldr sem_Elems_Cons sem_Elems_Nil (Prelude.map sem_Elem list) ) +-- semantic domain +newtype T_Elems = T_Elems ((Map NontermIdent (Attributes, Attributes)) -> + (Map NontermIdent (Set ConstructorIdent)) -> + DataTypes -> + (Set NontermIdent) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map Identifier (Set NontermIdent,Set Identifier)) -> + DefinedSets -> + Options -> + ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,Blocks,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),QuantMap,PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent))) +data Inh_Elems = Inh_Elems {allAttrDecls_Inh_Elems :: !((Map NontermIdent (Attributes, Attributes))),allConstructors_Inh_Elems :: !((Map NontermIdent (Set ConstructorIdent))),allFields_Inh_Elems :: !(DataTypes),allNonterminals_Inh_Elems :: !((Set NontermIdent)),attrDecls_Inh_Elems :: !((Map NontermIdent (Attributes, Attributes))),defSets_Inh_Elems :: !((Map Identifier (Set NontermIdent,Set Identifier))),definedSets_Inh_Elems :: !(DefinedSets),options_Inh_Elems :: !(Options)} +data Syn_Elems = Syn_Elems {attrDecls_Syn_Elems :: !((Map NontermIdent (Attributes, Attributes))),attrOrderCollect_Syn_Elems :: !(AttrOrderMap),blocks_Syn_Elems :: !(Blocks),collectedArounds_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedConstructorsMap_Syn_Elems :: !((Map NontermIdent (Set ConstructorIdent))),collectedFields_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedInsts_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMerges_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),collectedNames_Syn_Elems :: !((Set Identifier)),collectedRules_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, RuleInfo)])),collectedSetNames_Syn_Elems :: !((Set Identifier)),collectedSigs_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, SigInfo) ])),collectedUniques_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])),ctxCollect_Syn_Elems :: !(ContextMap),defSets_Syn_Elems :: !((Map Identifier (Set NontermIdent,Set Identifier))),derivings_Syn_Elems :: !(Derivings),errors_Syn_Elems :: !((Seq Error)),moduleDecl_Syn_Elems :: !((Maybe (String,String,String))),paramsCollect_Syn_Elems :: !(ParamMap),pragmas_Syn_Elems :: !((Options -> Options)),quantCollect_Syn_Elems :: !(QuantMap),semPragmasCollect_Syn_Elems :: !(PragmaMap),typeSyns_Syn_Elems :: !(TypeSyns),useMap_Syn_Elems :: !((Map NontermIdent (Map Identifier (String,String,String)))),wrappers_Syn_Elems :: !((Set NontermIdent))} +wrap_Elems :: T_Elems -> + Inh_Elems -> + Syn_Elems +wrap_Elems (T_Elems sem ) (Inh_Elems _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets _lhsIoptions ) = + (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets _lhsIoptions + in (Syn_Elems _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers )) +sem_Elems_Cons :: T_Elem -> + T_Elems -> + T_Elems +sem_Elems_Cons (T_Elem hd_ ) (T_Elems tl_ ) = + (T_Elems (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _hdOallFields :: DataTypes + _hdOallNonterminals :: (Set NontermIdent) + _hdOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _hdOdefinedSets :: DefinedSets + _hdOoptions :: Options + _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _tlOallFields :: DataTypes + _tlOallNonterminals :: (Set NontermIdent) + _tlOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _tlOdefinedSets :: DefinedSets + _tlOoptions :: Options + _hdIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdIattrOrderCollect :: AttrOrderMap + _hdIblocks :: Blocks + _hdIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _hdIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _hdIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _hdIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _hdIcollectedNames :: (Set Identifier) + _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _hdIcollectedSetNames :: (Set Identifier) + _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _hdIctxCollect :: ContextMap + _hdIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _hdIderivings :: Derivings + _hdIerrors :: (Seq Error) + _hdImoduleDecl :: (Maybe (String,String,String)) + _hdIparamsCollect :: ParamMap + _hdIpragmas :: (Options -> Options) + _hdIquantCollect :: QuantMap + _hdIsemPragmasCollect :: PragmaMap + _hdItypeSyns :: TypeSyns + _hdIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _hdIwrappers :: (Set NontermIdent) + _tlIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlIattrOrderCollect :: AttrOrderMap + _tlIblocks :: Blocks + _tlIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _tlIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _tlIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _tlIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _tlIcollectedNames :: (Set Identifier) + _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _tlIcollectedSetNames :: (Set Identifier) + _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _tlIctxCollect :: ContextMap + _tlIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _tlIderivings :: Derivings + _tlIerrors :: (Seq Error) + _tlImoduleDecl :: (Maybe (String,String,String)) + _tlIparamsCollect :: ParamMap + _tlIpragmas :: (Options -> Options) + _tlIquantCollect :: QuantMap + _tlIsemPragmasCollect :: PragmaMap + _tlItypeSyns :: TypeSyns + _tlIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _tlIwrappers :: (Set NontermIdent) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect + {-# LINE 4465 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + _hdIblocks `mapUnionWithPlusPlus` _tlIblocks + {-# LINE 4471 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + _hdIcollectedArounds ++ _tlIcollectedArounds + {-# LINE 4477 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + _hdIcollectedAugments ++ _tlIcollectedAugments + {-# LINE 4483 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap + {-# LINE 4489 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + _hdIcollectedFields ++ _tlIcollectedFields + {-# LINE 4495 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + _hdIcollectedInsts ++ _tlIcollectedInsts + {-# LINE 4501 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + _hdIcollectedMerges ++ _tlIcollectedMerges + {-# LINE 4507 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _hdIcollectedNames `Set.union` _tlIcollectedNames + {-# LINE 4513 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + _hdIcollectedRules ++ _tlIcollectedRules + {-# LINE 4519 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames + {-# LINE 4525 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + _hdIcollectedSigs ++ _tlIcollectedSigs + {-# LINE 4531 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + _hdIcollectedUniques ++ _tlIcollectedUniques + {-# LINE 4537 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + _hdIctxCollect `mergeCtx` _tlIctxCollect + {-# LINE 4543 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + _hdIderivings `mergeDerivings` _tlIderivings + {-# LINE 4549 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 4555 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + _hdImoduleDecl `mplus` _tlImoduleDecl + {-# LINE 4561 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + _hdIparamsCollect `mergeParams` _tlIparamsCollect + {-# LINE 4567 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + _hdIpragmas . _tlIpragmas + {-# LINE 4573 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + _hdIquantCollect `mergeQuant` _tlIquantCollect + {-# LINE 4579 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect + {-# LINE 4585 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + _hdItypeSyns ++ _tlItypeSyns + {-# LINE 4591 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + _hdIuseMap `merge` _tlIuseMap + {-# LINE 4597 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + _hdIwrappers `Set.union` _tlIwrappers + {-# LINE 4603 "Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _tlIattrDecls + {-# LINE 4609 "Transform.hs" #-} + ) + -- copy rule (up) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _tlIdefSets + {-# LINE 4615 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOallAttrDecls = + ({-# LINE 822 "Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 4621 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOallConstructors = + ({-# LINE 97 "Transform.ag" #-} + _lhsIallConstructors + {-# LINE 4627 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 4633 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 4639 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 4645 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 4651 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 4657 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 4663 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOallAttrDecls = + ({-# LINE 822 "Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 4669 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOallConstructors = + ({-# LINE 97 "Transform.ag" #-} + _lhsIallConstructors + {-# LINE 4675 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 4681 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 4687 "Transform.hs" #-} + ) + -- copy rule (chain) + _tlOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _hdIattrDecls + {-# LINE 4693 "Transform.hs" #-} + ) + -- copy rule (chain) + _tlOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _hdIdefSets + {-# LINE 4699 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 4705 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 4711 "Transform.hs" #-} + ) + ( _hdIattrDecls,_hdIattrOrderCollect,_hdIblocks,_hdIcollectedArounds,_hdIcollectedAugments,_hdIcollectedConstructorsMap,_hdIcollectedFields,_hdIcollectedInsts,_hdIcollectedMerges,_hdIcollectedNames,_hdIcollectedRules,_hdIcollectedSetNames,_hdIcollectedSigs,_hdIcollectedUniques,_hdIctxCollect,_hdIdefSets,_hdIderivings,_hdIerrors,_hdImoduleDecl,_hdIparamsCollect,_hdIpragmas,_hdIquantCollect,_hdIsemPragmasCollect,_hdItypeSyns,_hdIuseMap,_hdIwrappers) = + hd_ _hdOallAttrDecls _hdOallConstructors _hdOallFields _hdOallNonterminals _hdOattrDecls _hdOdefSets _hdOdefinedSets _hdOoptions + ( _tlIattrDecls,_tlIattrOrderCollect,_tlIblocks,_tlIcollectedArounds,_tlIcollectedAugments,_tlIcollectedConstructorsMap,_tlIcollectedFields,_tlIcollectedInsts,_tlIcollectedMerges,_tlIcollectedNames,_tlIcollectedRules,_tlIcollectedSetNames,_tlIcollectedSigs,_tlIcollectedUniques,_tlIctxCollect,_tlIdefSets,_tlIderivings,_tlIerrors,_tlImoduleDecl,_tlIparamsCollect,_tlIpragmas,_tlIquantCollect,_tlIsemPragmasCollect,_tlItypeSyns,_tlIuseMap,_tlIwrappers) = + tl_ _tlOallAttrDecls _tlOallConstructors _tlOallFields _tlOallNonterminals _tlOattrDecls _tlOdefSets _tlOdefinedSets _tlOoptions + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +sem_Elems_Nil :: T_Elems +sem_Elems_Nil = + (T_Elems (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 4758 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 45, column 19) + _lhsOblocks = + ({-# LINE 45 "Transform.ag" #-} + Map.empty + {-# LINE 4764 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 4770 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 4776 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 95, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 95 "Transform.ag" #-} + Map.empty + {-# LINE 4782 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 126, column 28) + _lhsOcollectedFields = + ({-# LINE 126 "Transform.ag" #-} + [] + {-# LINE 4788 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 4794 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 4800 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + Set.empty + {-# LINE 4806 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 4812 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 86, column 50) + _lhsOcollectedSetNames = + ({-# LINE 86 "Transform.ag" #-} + Set.empty + {-# LINE 4818 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 4824 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 4830 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 876, column 34) + _lhsOctxCollect = + ({-# LINE 876 "Transform.ag" #-} + Map.empty + {-# LINE 4836 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 918, column 33) + _lhsOderivings = + ({-# LINE 918 "Transform.ag" #-} + Map.empty + {-# LINE 4842 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 4848 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1114, column 37) + _lhsOmoduleDecl = + ({-# LINE 1114 "Transform.ag" #-} + mzero + {-# LINE 4854 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 853, column 37) + _lhsOparamsCollect = + ({-# LINE 853 "Transform.ag" #-} + Map.empty + {-# LINE 4860 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 747, column 34) + _lhsOpragmas = + ({-# LINE 747 "Transform.ag" #-} + id + {-# LINE 4866 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 901, column 36) + _lhsOquantCollect = + ({-# LINE 901 "Transform.ag" #-} + Map.empty + {-# LINE 4872 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 4878 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 596, column 32) + _lhsOtypeSyns = + ({-# LINE 596 "Transform.ag" #-} + [] + {-# LINE 4884 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 138, column 15) + _lhsOuseMap = + ({-# LINE 138 "Transform.ag" #-} + Map.empty + {-# LINE 4890 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 731, column 32) + _lhsOwrappers = + ({-# LINE 731 "Transform.ag" #-} + Set.empty + {-# LINE 4896 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 137 "Transform.ag" #-} + _lhsIattrDecls + {-# LINE 4902 "Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 105 "Transform.ag" #-} + _lhsIdefSets + {-# LINE 4908 "Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) +-- NontSet ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allFields : DataTypes + allNonterminals : Set NontermIdent + definedSets : DefinedSets + synthesized attributes: + collectedNames : Set Identifier + errors : Seq Error + nontSet : Set NontermIdent + alternatives: + alternative All: + alternative Difference: + child set1 : NontSet + child set2 : NontSet + alternative Intersect: + child set1 : NontSet + child set2 : NontSet + alternative NamedSet: + child name : {NontermIdent} + visit 0: + local _tup4 : _ + local nontSet : _ + local errors : _ + alternative Path: + child from : {NontermIdent} + child to : {NontermIdent} + alternative Union: + child set1 : NontSet + child set2 : NontSet +-} +-- cata +sem_NontSet :: NontSet -> + T_NontSet +sem_NontSet (All ) = + (sem_NontSet_All ) +sem_NontSet (Difference _set1 _set2 ) = + (sem_NontSet_Difference (sem_NontSet _set1 ) (sem_NontSet _set2 ) ) +sem_NontSet (Intersect _set1 _set2 ) = + (sem_NontSet_Intersect (sem_NontSet _set1 ) (sem_NontSet _set2 ) ) +sem_NontSet (NamedSet _name ) = + (sem_NontSet_NamedSet _name ) +sem_NontSet (Path _from _to ) = + (sem_NontSet_Path _from _to ) +sem_NontSet (Union _set1 _set2 ) = + (sem_NontSet_Union (sem_NontSet _set1 ) (sem_NontSet _set2 ) ) +-- semantic domain +newtype T_NontSet = T_NontSet (DataTypes -> + (Set NontermIdent) -> + DefinedSets -> + ( (Set Identifier),(Seq Error),(Set NontermIdent))) +data Inh_NontSet = Inh_NontSet {allFields_Inh_NontSet :: !(DataTypes),allNonterminals_Inh_NontSet :: !((Set NontermIdent)),definedSets_Inh_NontSet :: !(DefinedSets)} +data Syn_NontSet = Syn_NontSet {collectedNames_Syn_NontSet :: !((Set Identifier)),errors_Syn_NontSet :: !((Seq Error)),nontSet_Syn_NontSet :: !((Set NontermIdent))} +wrap_NontSet :: T_NontSet -> + Inh_NontSet -> + Syn_NontSet +wrap_NontSet (T_NontSet sem ) (Inh_NontSet _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets ) = + (let ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet) = sem _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets + in (Syn_NontSet _lhsOcollectedNames _lhsOerrors _lhsOnontSet )) +sem_NontSet_All :: T_NontSet +sem_NontSet_All = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + -- "Transform.ag"(line 677, column 16) + _lhsOnontSet = + ({-# LINE 677 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 4983 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + Set.empty + {-# LINE 4989 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 4995 "Transform.hs" #-} + ) + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))) ) +sem_NontSet_Difference :: T_NontSet -> + T_NontSet -> + T_NontSet +sem_NontSet_Difference (T_NontSet set1_ ) (T_NontSet set2_ ) = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _set1OallFields :: DataTypes + _set1OallNonterminals :: (Set NontermIdent) + _set1OdefinedSets :: DefinedSets + _set2OallFields :: DataTypes + _set2OallNonterminals :: (Set NontermIdent) + _set2OdefinedSets :: DefinedSets + _set1IcollectedNames :: (Set Identifier) + _set1Ierrors :: (Seq Error) + _set1InontSet :: (Set NontermIdent) + _set2IcollectedNames :: (Set Identifier) + _set2Ierrors :: (Seq Error) + _set2InontSet :: (Set NontermIdent) + -- "Transform.ag"(line 683, column 16) + _lhsOnontSet = + ({-# LINE 683 "Transform.ag" #-} + Set.difference _set1InontSet _set2InontSet + {-# LINE 5024 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _set1IcollectedNames `Set.union` _set2IcollectedNames + {-# LINE 5030 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 5036 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 5042 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5048 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5054 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 5060 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5066 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5072 "Transform.hs" #-} + ) + ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = + set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets + ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = + set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))) ) +sem_NontSet_Intersect :: T_NontSet -> + T_NontSet -> + T_NontSet +sem_NontSet_Intersect (T_NontSet set1_ ) (T_NontSet set2_ ) = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _set1OallFields :: DataTypes + _set1OallNonterminals :: (Set NontermIdent) + _set1OdefinedSets :: DefinedSets + _set2OallFields :: DataTypes + _set2OallNonterminals :: (Set NontermIdent) + _set2OdefinedSets :: DefinedSets + _set1IcollectedNames :: (Set Identifier) + _set1Ierrors :: (Seq Error) + _set1InontSet :: (Set NontermIdent) + _set2IcollectedNames :: (Set Identifier) + _set2Ierrors :: (Seq Error) + _set2InontSet :: (Set NontermIdent) + -- "Transform.ag"(line 682, column 16) + _lhsOnontSet = + ({-# LINE 682 "Transform.ag" #-} + Set.intersection _set1InontSet _set2InontSet + {-# LINE 5105 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _set1IcollectedNames `Set.union` _set2IcollectedNames + {-# LINE 5111 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 5117 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 5123 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5129 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5135 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 5141 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5147 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5153 "Transform.hs" #-} + ) + ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = + set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets + ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = + set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))) ) +sem_NontSet_NamedSet :: NontermIdent -> + T_NontSet +sem_NontSet_NamedSet name_ = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _lhsOnontSet :: (Set NontermIdent) + -- "Transform.ag"(line 558, column 14) + _lhsOcollectedNames = + ({-# LINE 558 "Transform.ag" #-} + Set.singleton name_ + {-# LINE 5173 "Transform.hs" #-} + ) + -- "Transform.ag"(line 678, column 20) + __tup4 = + ({-# LINE 678 "Transform.ag" #-} + case Map.lookup name_ _lhsIdefinedSets of + Nothing -> (Set.empty, Seq.singleton (UndefNont name_)) + Just set -> (set, Seq.empty) + {-# LINE 5181 "Transform.hs" #-} + ) + -- "Transform.ag"(line 678, column 20) + (_nontSet,_) = + ({-# LINE 678 "Transform.ag" #-} + __tup4 + {-# LINE 5187 "Transform.hs" #-} + ) + -- "Transform.ag"(line 678, column 20) + (_,_errors) = + ({-# LINE 678 "Transform.ag" #-} + __tup4 + {-# LINE 5193 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _errors + {-# LINE 5199 "Transform.hs" #-} + ) + -- copy rule (from local) + _lhsOnontSet = + ({-# LINE 113 "Transform.ag" #-} + _nontSet + {-# LINE 5205 "Transform.hs" #-} + ) + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))) ) +sem_NontSet_Path :: NontermIdent -> + NontermIdent -> + T_NontSet +sem_NontSet_Path from_ to_ = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOerrors :: (Seq Error) + _lhsOcollectedNames :: (Set Identifier) + -- "Transform.ag"(line 684, column 16) + _lhsOnontSet = + ({-# LINE 684 "Transform.ag" #-} + let table = flattenDatas _lhsIallFields + in path table from_ to_ + {-# LINE 5223 "Transform.hs" #-} + ) + -- "Transform.ag"(line 686, column 16) + _lhsOerrors = + ({-# LINE 686 "Transform.ag" #-} + let check name | Set.member name _lhsIallNonterminals + = Seq.empty + | otherwise = Seq.singleton (UndefNont name) + in check from_ >< check to_ + {-# LINE 5232 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + Set.empty + {-# LINE 5238 "Transform.hs" #-} + ) + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))) ) +sem_NontSet_Union :: T_NontSet -> + T_NontSet -> + T_NontSet +sem_NontSet_Union (T_NontSet set1_ ) (T_NontSet set2_ ) = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _set1OallFields :: DataTypes + _set1OallNonterminals :: (Set NontermIdent) + _set1OdefinedSets :: DefinedSets + _set2OallFields :: DataTypes + _set2OallNonterminals :: (Set NontermIdent) + _set2OdefinedSets :: DefinedSets + _set1IcollectedNames :: (Set Identifier) + _set1Ierrors :: (Seq Error) + _set1InontSet :: (Set NontermIdent) + _set2IcollectedNames :: (Set Identifier) + _set2Ierrors :: (Seq Error) + _set2InontSet :: (Set NontermIdent) + -- "Transform.ag"(line 681, column 16) + _lhsOnontSet = + ({-# LINE 681 "Transform.ag" #-} + Set.union _set1InontSet _set2InontSet + {-# LINE 5267 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 87, column 50) + _lhsOcollectedNames = + ({-# LINE 87 "Transform.ag" #-} + _set1IcollectedNames `Set.union` _set2IcollectedNames + {-# LINE 5273 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 5279 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 5285 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5291 "Transform.hs" #-} + ) + -- copy rule (down) + _set1OdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5297 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 5303 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OallNonterminals = + ({-# LINE 89 "Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5309 "Transform.hs" #-} + ) + -- copy rule (down) + _set2OdefinedSets = + ({-# LINE 108 "Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5315 "Transform.hs" #-} + ) + ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = + set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets + ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = + set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + definedAttrs : [AttrName] + definedInsts : [Identifier] + patunder : [AttrName]->Pattern + stpos : Pos + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern ,([AttrName]),([Identifier]),([AttrName]->Pattern),Pos)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern ),definedAttrs_Syn_Pattern :: !(([AttrName])),definedInsts_Syn_Pattern :: !(([Identifier])),patunder_Syn_Pattern :: !(([AttrName]->Pattern)),stpos_Syn_Pattern :: !(Pos)} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos) = sem + in (Syn_Pattern _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOdefinedAttrs :: ([AttrName]) + _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOstpos :: Pos + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIdefinedAttrs :: ([AttrName]) + _patIdefinedInsts :: ([Identifier]) + _patIpatunder :: ([AttrName]->Pattern) + _patIstpos :: Pos + _partsIcopy :: Patterns + _partsIdefinedAttrs :: ([AttrName]) + _partsIdefinedInsts :: ([Identifier]) + _partsIpatunder :: ([AttrName]->Patterns) + -- "Transform.ag"(line 1090, column 11) + _lhsOdefinedAttrs = + ({-# LINE 1090 "Transform.ag" #-} + (field_, attr_) : _patIdefinedAttrs + {-# LINE 5405 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1091, column 11) + _lhsOpatunder = + ({-# LINE 1091 "Transform.ag" #-} + \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy + {-# LINE 5411 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1092, column 11) + _lhsOdefinedInsts = + ({-# LINE 1092 "Transform.ag" #-} + (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts + {-# LINE 5417 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1107, column 16) + _lhsOstpos = + ({-# LINE 1107 "Transform.ag" #-} + getPos field_ + {-# LINE 5423 "Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 5429 "Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 5435 "Transform.hs" #-} + ) + ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = + pat_ + ( _partsIcopy,_partsIdefinedAttrs,_partsIdefinedInsts,_partsIpatunder) = + parts_ + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOstpos :: Pos + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIdefinedAttrs :: ([AttrName]) + _patsIdefinedInsts :: ([Identifier]) + _patsIpatunder :: ([AttrName]->Patterns) + -- "Transform.ag"(line 1094, column 12) + _lhsOpatunder = + ({-# LINE 1094 "Transform.ag" #-} + \us -> Constr name_ (_patsIpatunder us) + {-# LINE 5459 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1105, column 16) + _lhsOstpos = + ({-# LINE 1105 "Transform.ag" #-} + getPos name_ + {-# LINE 5465 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1085, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1085 "Transform.ag" #-} + _patsIdefinedAttrs + {-# LINE 5471 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + _patsIdefinedInsts + {-# LINE 5477 "Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 5483 "Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 5489 "Transform.hs" #-} + ) + ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = + pats_ + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Pattern + _lhsOstpos :: Pos + _patIcopy :: Pattern + _patIdefinedAttrs :: ([AttrName]) + _patIdefinedInsts :: ([Identifier]) + _patIpatunder :: ([AttrName]->Pattern) + _patIstpos :: Pos + -- "Transform.ag"(line 1096, column 17) + _lhsOpatunder = + ({-# LINE 1096 "Transform.ag" #-} + \us -> Irrefutable (_patIpatunder us) + {-# LINE 5511 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1085, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1085 "Transform.ag" #-} + _patIdefinedAttrs + {-# LINE 5517 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + _patIdefinedInsts + {-# LINE 5523 "Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 5529 "Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 5535 "Transform.hs" #-} + ) + -- copy rule (up) + _lhsOstpos = + ({-# LINE 1102 "Transform.ag" #-} + _patIstpos + {-# LINE 5541 "Transform.hs" #-} + ) + ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = + pat_ + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOstpos :: Pos + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIdefinedAttrs :: ([AttrName]) + _patsIdefinedInsts :: ([Identifier]) + _patsIpatunder :: ([AttrName]->Patterns) + -- "Transform.ag"(line 1095, column 13) + _lhsOpatunder = + ({-# LINE 1095 "Transform.ag" #-} + \us -> Product pos_ (_patsIpatunder us) + {-# LINE 5563 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1106, column 16) + _lhsOstpos = + ({-# LINE 1106 "Transform.ag" #-} + pos_ + {-# LINE 5569 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1085, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1085 "Transform.ag" #-} + _patsIdefinedAttrs + {-# LINE 5575 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + _patsIdefinedInsts + {-# LINE 5581 "Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 5587 "Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 5593 "Transform.hs" #-} + ) + ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = + pats_ + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOstpos :: Pos + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Pattern + -- "Transform.ag"(line 1093, column 16) + _lhsOpatunder = + ({-# LINE 1093 "Transform.ag" #-} + \us -> _copy + {-# LINE 5610 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1108, column 16) + _lhsOstpos = + ({-# LINE 1108 "Transform.ag" #-} + pos_ + {-# LINE 5616 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1085, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1085 "Transform.ag" #-} + [] + {-# LINE 5622 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 5628 "Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 5634 "Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 5640 "Transform.hs" #-} + ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + definedAttrs : [AttrName] + definedInsts : [Identifier] + patunder : [AttrName]->Patterns + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( Patterns ,([AttrName]),([Identifier]),([AttrName]->Patterns))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns ),definedAttrs_Syn_Patterns :: !(([AttrName])),definedInsts_Syn_Patterns :: !(([Identifier])),patunder_Syn_Patterns :: !(([AttrName]->Patterns))} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder) = sem + in (Syn_Patterns _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns) + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIdefinedAttrs :: ([AttrName]) + _hdIdefinedInsts :: ([Identifier]) + _hdIpatunder :: ([AttrName]->Pattern) + _hdIstpos :: Pos + _tlIcopy :: Patterns + _tlIdefinedAttrs :: ([AttrName]) + _tlIdefinedInsts :: ([Identifier]) + _tlIpatunder :: ([AttrName]->Patterns) + -- "Transform.ag"(line 1100, column 10) + _lhsOpatunder = + ({-# LINE 1100 "Transform.ag" #-} + \us -> (_hdIpatunder us) : (_tlIpatunder us) + {-# LINE 5697 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1085, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1085 "Transform.ag" #-} + _hdIdefinedAttrs ++ _tlIdefinedAttrs + {-# LINE 5703 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + _hdIdefinedInsts ++ _tlIdefinedInsts + {-# LINE 5709 "Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 5715 "Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 5721 "Transform.hs" #-} + ) + ( _hdIcopy,_hdIdefinedAttrs,_hdIdefinedInsts,_hdIpatunder,_hdIstpos) = + hd_ + ( _tlIcopy,_tlIdefinedAttrs,_tlIdefinedInsts,_tlIpatunder) = + tl_ + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns) + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Patterns + -- "Transform.ag"(line 1099, column 9) + _lhsOpatunder = + ({-# LINE 1099 "Transform.ag" #-} + \us -> [] + {-# LINE 5738 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1085, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1085 "Transform.ag" #-} + [] + {-# LINE 5744 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 5750 "Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 5756 "Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 5762 "Transform.hs" #-} + ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder)) ) +-- SemAlt ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allFields : DataTypes + nts : Set NontermIdent + options : Options + synthesized attributes: + attrOrderCollect : AttrOrderMap + collectedArounds : [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] + collectedAugments : [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedMerges : [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] + collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] + collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] + collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] + errors : Seq Error + semPragmasCollect : PragmaMap + alternatives: + alternative SemAlt: + child pos : {Pos} + child constructorSet : ConstructorSet + child rules : SemDefs + visit 0: + local pragmaNames : _ + local attrOrders : _ + local coninfo : _ +-} +-- cata +sem_SemAlt :: SemAlt -> + T_SemAlt +sem_SemAlt (SemAlt _pos _constructorSet _rules ) = + (sem_SemAlt_SemAlt _pos (sem_ConstructorSet _constructorSet ) (sem_SemDefs _rules ) ) +-- semantic domain +newtype T_SemAlt = T_SemAlt ((Map NontermIdent (Attributes, Attributes)) -> + DataTypes -> + (Set NontermIdent) -> + Options -> + ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(Seq Error),PragmaMap)) +data Inh_SemAlt = Inh_SemAlt {allAttrDecls_Inh_SemAlt :: !((Map NontermIdent (Attributes, Attributes))),allFields_Inh_SemAlt :: !(DataTypes),nts_Inh_SemAlt :: !((Set NontermIdent)),options_Inh_SemAlt :: !(Options)} +data Syn_SemAlt = Syn_SemAlt {attrOrderCollect_Syn_SemAlt :: !(AttrOrderMap),collectedArounds_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedInsts_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMerges_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),collectedRules_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, RuleInfo)])),collectedSigs_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, SigInfo) ])),collectedUniques_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])),errors_Syn_SemAlt :: !((Seq Error)),semPragmasCollect_Syn_SemAlt :: !(PragmaMap)} +wrap_SemAlt :: T_SemAlt -> + Inh_SemAlt -> + Syn_SemAlt +wrap_SemAlt (T_SemAlt sem ) (Inh_SemAlt _lhsIallAttrDecls _lhsIallFields _lhsInts _lhsIoptions ) = + (let ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = sem _lhsIallAttrDecls _lhsIallFields _lhsInts _lhsIoptions + in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect )) +sem_SemAlt_SemAlt :: Pos -> + T_ConstructorSet -> + T_SemDefs -> + T_SemAlt +sem_SemAlt_SemAlt pos_ (T_ConstructorSet constructorSet_ ) (T_SemDefs rules_ ) = + (T_SemAlt (\ _lhsIallAttrDecls + _lhsIallFields + _lhsInts + _lhsIoptions -> + (let _lhsOsemPragmasCollect :: PragmaMap + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOerrors :: (Seq Error) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _rulesOoptions :: Options + _constructorSetIcollectedConstructorNames :: (Set ConstructorIdent) + _constructorSetIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _constructorSetIerrors :: (Seq Error) + _rulesIaroundInfos :: ([AroundInfo]) + _rulesIaugmentInfos :: ([AugmentInfo]) + _rulesIdefinedInsts :: ([Identifier]) + _rulesIerrors :: (Seq Error) + _rulesImergeInfos :: ([MergeInfo]) + _rulesIorderDepsCollect :: (Set Dependency) + _rulesIpragmaNamesCollect :: ([Identifier]) + _rulesIruleInfos :: ([RuleInfo]) + _rulesIsigInfos :: ([SigInfo]) + _rulesIuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 797, column 7) + _pragmaNames = + ({-# LINE 797 "Transform.ag" #-} + Set.fromList _rulesIpragmaNamesCollect + {-# LINE 5850 "Transform.hs" #-} + ) + -- "Transform.ag"(line 798, column 7) + _lhsOsemPragmasCollect = + ({-# LINE 798 "Transform.ag" #-} + foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 5859 "Transform.hs" #-} + ) + -- "Transform.ag"(line 826, column 7) + _attrOrders = + ({-# LINE 826 "Transform.ag" #-} + [ orderMapSingle nt con _rulesIorderDepsCollect + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 5868 "Transform.hs" #-} + ) + -- "Transform.ag"(line 832, column 7) + _lhsOattrOrderCollect = + ({-# LINE 832 "Transform.ag" #-} + foldr orderMapUnion Map.empty _attrOrders + {-# LINE 5874 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1009, column 12) + _coninfo = + ({-# LINE 1009 "Transform.ag" #-} + [ (nt, conset, conkeys) + | nt <- Set.toList _lhsInts + , let conmap = Map.findWithDefault Map.empty nt _lhsIallFields + , let conkeys = Set.fromList (Map.keys conmap) + , let conset = _constructorSetIconstructors conkeys + ] + {-# LINE 5885 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1016, column 12) + _lhsOerrors = + ({-# LINE 1016 "Transform.ag" #-} + Seq.fromList + [ UndefAlt nt con + | (nt, conset, conkeys) <- _coninfo + , con <- Set.toList (Set.difference conset conkeys) + ] + Seq.>< _rulesIerrors + {-# LINE 5896 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1022, column 12) + _lhsOcollectedRules = + ({-# LINE 1022 "Transform.ag" #-} + [ (nt,con,r) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + , r <- _rulesIruleInfos + ] + {-# LINE 5906 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1028, column 12) + _lhsOcollectedSigs = + ({-# LINE 1028 "Transform.ag" #-} + [ (nt,con,ts) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + , ts <- _rulesIsigInfos + ] + {-# LINE 5916 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1035, column 12) + _lhsOcollectedInsts = + ({-# LINE 1035 "Transform.ag" #-} + [ (nt,con,_rulesIdefinedInsts) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 5925 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1041, column 12) + _lhsOcollectedUniques = + ({-# LINE 1041 "Transform.ag" #-} + [ (nt,con,_rulesIuniqueInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 5934 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1047, column 12) + _lhsOcollectedAugments = + ({-# LINE 1047 "Transform.ag" #-} + [ (nt, con, _rulesIaugmentInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 5943 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1053, column 12) + _lhsOcollectedArounds = + ({-# LINE 1053 "Transform.ag" #-} + [ (nt, con, _rulesIaroundInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 5952 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1059, column 12) + _lhsOcollectedMerges = + ({-# LINE 1059 "Transform.ag" #-} + [ (nt, con, _rulesImergeInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 5961 "Transform.hs" #-} + ) + -- copy rule (down) + _rulesOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 5967 "Transform.hs" #-} + ) + ( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) = + constructorSet_ + ( _rulesIaroundInfos,_rulesIaugmentInfos,_rulesIdefinedInsts,_rulesIerrors,_rulesImergeInfos,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos,_rulesIuniqueInfos) = + rules_ _rulesOoptions + in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect))) ) +-- SemAlts ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allFields : DataTypes + nts : Set NontermIdent + options : Options + synthesized attributes: + attrOrderCollect : AttrOrderMap + collectedArounds : [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] + collectedAugments : [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedMerges : [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] + collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] + collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] + collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] + errors : Seq Error + semPragmasCollect : PragmaMap + alternatives: + alternative Cons: + child hd : SemAlt + child tl : SemAlts + alternative Nil: +-} +-- cata +sem_SemAlts :: SemAlts -> + T_SemAlts +sem_SemAlts list = + (Prelude.foldr sem_SemAlts_Cons sem_SemAlts_Nil (Prelude.map sem_SemAlt list) ) +-- semantic domain +newtype T_SemAlts = T_SemAlts ((Map NontermIdent (Attributes, Attributes)) -> + DataTypes -> + (Set NontermIdent) -> + Options -> + ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(Seq Error),PragmaMap)) +data Inh_SemAlts = Inh_SemAlts {allAttrDecls_Inh_SemAlts :: !((Map NontermIdent (Attributes, Attributes))),allFields_Inh_SemAlts :: !(DataTypes),nts_Inh_SemAlts :: !((Set NontermIdent)),options_Inh_SemAlts :: !(Options)} +data Syn_SemAlts = Syn_SemAlts {attrOrderCollect_Syn_SemAlts :: !(AttrOrderMap),collectedArounds_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedInsts_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMerges_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),collectedRules_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, RuleInfo)])),collectedSigs_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, SigInfo) ])),collectedUniques_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])),errors_Syn_SemAlts :: !((Seq Error)),semPragmasCollect_Syn_SemAlts :: !(PragmaMap)} +wrap_SemAlts :: T_SemAlts -> + Inh_SemAlts -> + Syn_SemAlts +wrap_SemAlts (T_SemAlts sem ) (Inh_SemAlts _lhsIallAttrDecls _lhsIallFields _lhsInts _lhsIoptions ) = + (let ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = sem _lhsIallAttrDecls _lhsIallFields _lhsInts _lhsIoptions + in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect )) +sem_SemAlts_Cons :: T_SemAlt -> + T_SemAlts -> + T_SemAlts +sem_SemAlts_Cons (T_SemAlt hd_ ) (T_SemAlts tl_ ) = + (T_SemAlts (\ _lhsIallAttrDecls + _lhsIallFields + _lhsInts + _lhsIoptions -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOerrors :: (Seq Error) + _lhsOsemPragmasCollect :: PragmaMap + _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOallFields :: DataTypes + _hdOnts :: (Set NontermIdent) + _hdOoptions :: Options + _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOallFields :: DataTypes + _tlOnts :: (Set NontermIdent) + _tlOoptions :: Options + _hdIattrOrderCollect :: AttrOrderMap + _hdIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _hdIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _hdIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _hdIerrors :: (Seq Error) + _hdIsemPragmasCollect :: PragmaMap + _tlIattrOrderCollect :: AttrOrderMap + _tlIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _tlIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _tlIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _tlIerrors :: (Seq Error) + _tlIsemPragmasCollect :: PragmaMap + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect + {-# LINE 6068 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + _hdIcollectedArounds ++ _tlIcollectedArounds + {-# LINE 6074 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + _hdIcollectedAugments ++ _tlIcollectedAugments + {-# LINE 6080 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + _hdIcollectedInsts ++ _tlIcollectedInsts + {-# LINE 6086 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + _hdIcollectedMerges ++ _tlIcollectedMerges + {-# LINE 6092 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + _hdIcollectedRules ++ _tlIcollectedRules + {-# LINE 6098 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + _hdIcollectedSigs ++ _tlIcollectedSigs + {-# LINE 6104 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + _hdIcollectedUniques ++ _tlIcollectedUniques + {-# LINE 6110 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 6116 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect + {-# LINE 6122 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOallAttrDecls = + ({-# LINE 822 "Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 6128 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 6134 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOnts = + ({-# LINE 168 "Transform.ag" #-} + _lhsInts + {-# LINE 6140 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 6146 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOallAttrDecls = + ({-# LINE 822 "Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 6152 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOallFields = + ({-# LINE 129 "Transform.ag" #-} + _lhsIallFields + {-# LINE 6158 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOnts = + ({-# LINE 168 "Transform.ag" #-} + _lhsInts + {-# LINE 6164 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 6170 "Transform.hs" #-} + ) + ( _hdIattrOrderCollect,_hdIcollectedArounds,_hdIcollectedAugments,_hdIcollectedInsts,_hdIcollectedMerges,_hdIcollectedRules,_hdIcollectedSigs,_hdIcollectedUniques,_hdIerrors,_hdIsemPragmasCollect) = + hd_ _hdOallAttrDecls _hdOallFields _hdOnts _hdOoptions + ( _tlIattrOrderCollect,_tlIcollectedArounds,_tlIcollectedAugments,_tlIcollectedInsts,_tlIcollectedMerges,_tlIcollectedRules,_tlIcollectedSigs,_tlIcollectedUniques,_tlIerrors,_tlIsemPragmasCollect) = + tl_ _tlOallAttrDecls _tlOallFields _tlOnts _tlOoptions + in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect))) ) +sem_SemAlts_Nil :: T_SemAlts +sem_SemAlts_Nil = + (T_SemAlts (\ _lhsIallAttrDecls + _lhsIallFields + _lhsInts + _lhsIoptions -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOerrors :: (Seq Error) + _lhsOsemPragmasCollect :: PragmaMap + -- use rule "Transform.ag"(line 821, column 55) + _lhsOattrOrderCollect = + ({-# LINE 821 "Transform.ag" #-} + Map.empty + {-# LINE 6197 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 157, column 32) + _lhsOcollectedArounds = + ({-# LINE 157 "Transform.ag" #-} + [] + {-# LINE 6203 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 156, column 32) + _lhsOcollectedAugments = + ({-# LINE 156 "Transform.ag" #-} + [] + {-# LINE 6209 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 154, column 32) + _lhsOcollectedInsts = + ({-# LINE 154 "Transform.ag" #-} + [] + {-# LINE 6215 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 158, column 32) + _lhsOcollectedMerges = + ({-# LINE 158 "Transform.ag" #-} + [] + {-# LINE 6221 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 152, column 32) + _lhsOcollectedRules = + ({-# LINE 152 "Transform.ag" #-} + [] + {-# LINE 6227 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 153, column 32) + _lhsOcollectedSigs = + ({-# LINE 153 "Transform.ag" #-} + [] + {-# LINE 6233 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 155, column 32) + _lhsOcollectedUniques = + ({-# LINE 155 "Transform.ag" #-} + [] + {-# LINE 6239 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 6245 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 793, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 793 "Transform.ag" #-} + Map.empty + {-# LINE 6251 "Transform.hs" #-} + ) + in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect))) ) +-- SemDef ------------------------------------------------------ +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + aroundInfos : [AroundInfo] + augmentInfos : [AugmentInfo] + definedInsts : [Identifier] + errors : Seq Error + mergeInfos : [MergeInfo] + orderDepsCollect : Set Dependency + pragmaNamesCollect : [Identifier] + ruleInfos : [RuleInfo] + sigInfos : [SigInfo] + uniqueInfos : [UniqueInfo] + alternatives: + alternative AroundDef: + child ident : {Identifier} + child rhs : {Expression} + alternative AttrOrderBefore: + child before : {[Occurrence]} + child after : {[Occurrence]} + visit 0: + local dependency : _ + alternative AugmentDef: + child ident : {Identifier} + child rhs : {Expression} + alternative Def: + child pos : {Pos} + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : {Expression} + child owrt : {Bool} + alternative MergeDef: + child target : {Identifier} + child nt : {Identifier} + child sources : {[Identifier]} + child rhs : {Expression} + alternative SemPragma: + child names : {[NontermIdent]} + alternative TypeDef: + child pos : {Pos} + child ident : {Identifier} + child tp : {Type} + alternative UniqueDef: + child ident : {Identifier} + child ref : {Identifier} +-} +-- cata +sem_SemDef :: SemDef -> + T_SemDef +sem_SemDef (AroundDef _ident _rhs ) = + (sem_SemDef_AroundDef _ident _rhs ) +sem_SemDef (AttrOrderBefore _before _after ) = + (sem_SemDef_AttrOrderBefore _before _after ) +sem_SemDef (AugmentDef _ident _rhs ) = + (sem_SemDef_AugmentDef _ident _rhs ) +sem_SemDef (Def _pos _mbName _pattern _rhs _owrt ) = + (sem_SemDef_Def _pos _mbName (sem_Pattern _pattern ) _rhs _owrt ) +sem_SemDef (MergeDef _target _nt _sources _rhs ) = + (sem_SemDef_MergeDef _target _nt _sources _rhs ) +sem_SemDef (SemPragma _names ) = + (sem_SemDef_SemPragma _names ) +sem_SemDef (TypeDef _pos _ident _tp ) = + (sem_SemDef_TypeDef _pos _ident _tp ) +sem_SemDef (UniqueDef _ident _ref ) = + (sem_SemDef_UniqueDef _ident _ref ) +-- semantic domain +newtype T_SemDef = T_SemDef (Options -> + ( ([AroundInfo]),([AugmentInfo]),([Identifier]),(Seq Error),([MergeInfo]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo]))) +data Inh_SemDef = Inh_SemDef {options_Inh_SemDef :: !(Options)} +data Syn_SemDef = Syn_SemDef {aroundInfos_Syn_SemDef :: !(([AroundInfo])),augmentInfos_Syn_SemDef :: !(([AugmentInfo])),definedInsts_Syn_SemDef :: !(([Identifier])),errors_Syn_SemDef :: !((Seq Error)),mergeInfos_Syn_SemDef :: !(([MergeInfo])),orderDepsCollect_Syn_SemDef :: !((Set Dependency)),pragmaNamesCollect_Syn_SemDef :: !(([Identifier])),ruleInfos_Syn_SemDef :: !(([RuleInfo])),sigInfos_Syn_SemDef :: !(([SigInfo])),uniqueInfos_Syn_SemDef :: !(([UniqueInfo]))} +wrap_SemDef :: T_SemDef -> + Inh_SemDef -> + Syn_SemDef +wrap_SemDef (T_SemDef sem ) (Inh_SemDef _lhsIoptions ) = + (let ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = sem _lhsIoptions + in (Syn_SemDef _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos )) +sem_SemDef_AroundDef :: Identifier -> + Expression -> + T_SemDef +sem_SemDef_AroundDef ident_ rhs_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 1078, column 17) + _lhsOaroundInfos = + ({-# LINE 1078 "Transform.ag" #-} + [ (ident_, rhs_) ] + {-# LINE 6352 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + [] + {-# LINE 6358 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 6364 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 6370 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + [] + {-# LINE 6376 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + Set.empty + {-# LINE 6382 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + [] + {-# LINE 6388 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + [] + {-# LINE 6394 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + [] + {-# LINE 6400 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + [] + {-# LINE 6406 "Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +sem_SemDef_AttrOrderBefore :: ([Occurrence]) -> + ([Occurrence]) -> + T_SemDef +sem_SemDef_AttrOrderBefore before_ after_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOorderDepsCollect :: (Set Dependency) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 838, column 7) + _dependency = + ({-# LINE 838 "Transform.ag" #-} + [ Dependency b a | b <- before_, a <- after_ ] + {-# LINE 6428 "Transform.hs" #-} + ) + -- "Transform.ag"(line 839, column 7) + _lhsOorderDepsCollect = + ({-# LINE 839 "Transform.ag" #-} + Set.fromList _dependency + {-# LINE 6434 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + [] + {-# LINE 6440 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + [] + {-# LINE 6446 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 6452 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 6458 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + [] + {-# LINE 6464 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + [] + {-# LINE 6470 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + [] + {-# LINE 6476 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + [] + {-# LINE 6482 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + [] + {-# LINE 6488 "Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +sem_SemDef_AugmentDef :: Identifier -> + Expression -> + T_SemDef +sem_SemDef_AugmentDef ident_ rhs_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 1075, column 17) + _lhsOaugmentInfos = + ({-# LINE 1075 "Transform.ag" #-} + [ (ident_, rhs_) ] + {-# LINE 6510 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + [] + {-# LINE 6516 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 6522 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 6528 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + [] + {-# LINE 6534 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + Set.empty + {-# LINE 6540 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + [] + {-# LINE 6546 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + [] + {-# LINE 6552 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + [] + {-# LINE 6558 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + [] + {-# LINE 6564 "Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +sem_SemDef_Def :: Pos -> + (Maybe Identifier) -> + T_Pattern -> + Expression -> + Bool -> + T_SemDef +sem_SemDef_Def pos_ mbName_ (T_Pattern pattern_ ) rhs_ owrt_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOerrors :: (Seq Error) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + _patternIcopy :: Pattern + _patternIdefinedAttrs :: ([AttrName]) + _patternIdefinedInsts :: ([Identifier]) + _patternIpatunder :: ([AttrName]->Pattern) + _patternIstpos :: Pos + -- "Transform.ag"(line 528, column 3) + _lhsOerrors = + ({-# LINE 528 "Transform.ag" #-} + if checkParseRhs _lhsIoptions + then Seq.fromList $ checkRhs rhs_ + else Seq.empty + {-# LINE 6596 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1066, column 10) + _lhsOruleInfos = + ({-# LINE 1066 "Transform.ag" #-} + [ (mbName_, _patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ] + {-# LINE 6602 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + [] + {-# LINE 6608 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + [] + {-# LINE 6614 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + _patternIdefinedInsts + {-# LINE 6620 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + [] + {-# LINE 6626 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + Set.empty + {-# LINE 6632 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + [] + {-# LINE 6638 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + [] + {-# LINE 6644 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + [] + {-# LINE 6650 "Transform.hs" #-} + ) + ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) = + pattern_ + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +sem_SemDef_MergeDef :: Identifier -> + Identifier -> + ([Identifier]) -> + Expression -> + T_SemDef +sem_SemDef_MergeDef target_ nt_ sources_ rhs_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 528, column 3) + _lhsOerrors = + ({-# LINE 528 "Transform.ag" #-} + if checkParseRhs _lhsIoptions + then Seq.fromList $ checkRhs rhs_ + else Seq.empty + {-# LINE 6678 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1081, column 17) + _lhsOmergeInfos = + ({-# LINE 1081 "Transform.ag" #-} + [ (target_, nt_, sources_, rhs_) ] + {-# LINE 6684 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + [] + {-# LINE 6690 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + [] + {-# LINE 6696 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 6702 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + Set.empty + {-# LINE 6708 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + [] + {-# LINE 6714 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + [] + {-# LINE 6720 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + [] + {-# LINE 6726 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + [] + {-# LINE 6732 "Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +sem_SemDef_SemPragma :: ([NontermIdent]) -> + T_SemDef +sem_SemDef_SemPragma names_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 807, column 7) + _lhsOpragmaNamesCollect = + ({-# LINE 807 "Transform.ag" #-} + names_ + {-# LINE 6753 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + [] + {-# LINE 6759 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + [] + {-# LINE 6765 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 6771 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 6777 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + [] + {-# LINE 6783 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + Set.empty + {-# LINE 6789 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + [] + {-# LINE 6795 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + [] + {-# LINE 6801 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + [] + {-# LINE 6807 "Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +sem_SemDef_TypeDef :: Pos -> + Identifier -> + Type -> + T_SemDef +sem_SemDef_TypeDef pos_ ident_ tp_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOerrors :: (Seq Error) + _lhsOsigInfos :: ([SigInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 535, column 3) + _lhsOerrors = + ({-# LINE 535 "Transform.ag" #-} + if checkParseTy _lhsIoptions + then case tp_ of + Haskell s -> let exp = Expression pos_ tks + tks = [tk] + tk = HsToken s pos_ + in Seq.fromList $ checkTy exp + _ -> Seq.empty + else Seq.empty + {-# LINE 6837 "Transform.hs" #-} + ) + -- "Transform.ag"(line 1069, column 14) + _lhsOsigInfos = + ({-# LINE 1069 "Transform.ag" #-} + [ (ident_, tp_) ] + {-# LINE 6843 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + [] + {-# LINE 6849 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + [] + {-# LINE 6855 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 6861 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + [] + {-# LINE 6867 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + Set.empty + {-# LINE 6873 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + [] + {-# LINE 6879 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + [] + {-# LINE 6885 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + [] + {-# LINE 6891 "Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +sem_SemDef_UniqueDef :: Identifier -> + Identifier -> + T_SemDef +sem_SemDef_UniqueDef ident_ ref_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOuniqueInfos :: ([UniqueInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + -- "Transform.ag"(line 1072, column 16) + _lhsOuniqueInfos = + ({-# LINE 1072 "Transform.ag" #-} + [ (ident_, ref_) ] + {-# LINE 6913 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + [] + {-# LINE 6919 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + [] + {-# LINE 6925 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 6931 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 6937 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + [] + {-# LINE 6943 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + Set.empty + {-# LINE 6949 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + [] + {-# LINE 6955 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + [] + {-# LINE 6961 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + [] + {-# LINE 6967 "Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +-- SemDefs ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + aroundInfos : [AroundInfo] + augmentInfos : [AugmentInfo] + definedInsts : [Identifier] + errors : Seq Error + mergeInfos : [MergeInfo] + orderDepsCollect : Set Dependency + pragmaNamesCollect : [Identifier] + ruleInfos : [RuleInfo] + sigInfos : [SigInfo] + uniqueInfos : [UniqueInfo] + alternatives: + alternative Cons: + child hd : SemDef + child tl : SemDefs + alternative Nil: +-} +-- cata +sem_SemDefs :: SemDefs -> + T_SemDefs +sem_SemDefs list = + (Prelude.foldr sem_SemDefs_Cons sem_SemDefs_Nil (Prelude.map sem_SemDef list) ) +-- semantic domain +newtype T_SemDefs = T_SemDefs (Options -> + ( ([AroundInfo]),([AugmentInfo]),([Identifier]),(Seq Error),([MergeInfo]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo]))) +data Inh_SemDefs = Inh_SemDefs {options_Inh_SemDefs :: !(Options)} +data Syn_SemDefs = Syn_SemDefs {aroundInfos_Syn_SemDefs :: !(([AroundInfo])),augmentInfos_Syn_SemDefs :: !(([AugmentInfo])),definedInsts_Syn_SemDefs :: !(([Identifier])),errors_Syn_SemDefs :: !((Seq Error)),mergeInfos_Syn_SemDefs :: !(([MergeInfo])),orderDepsCollect_Syn_SemDefs :: !((Set Dependency)),pragmaNamesCollect_Syn_SemDefs :: !(([Identifier])),ruleInfos_Syn_SemDefs :: !(([RuleInfo])),sigInfos_Syn_SemDefs :: !(([SigInfo])),uniqueInfos_Syn_SemDefs :: !(([UniqueInfo]))} +wrap_SemDefs :: T_SemDefs -> + Inh_SemDefs -> + Syn_SemDefs +wrap_SemDefs (T_SemDefs sem ) (Inh_SemDefs _lhsIoptions ) = + (let ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = sem _lhsIoptions + in (Syn_SemDefs _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos )) +sem_SemDefs_Cons :: T_SemDef -> + T_SemDefs -> + T_SemDefs +sem_SemDefs_Cons (T_SemDef hd_ ) (T_SemDefs tl_ ) = + (T_SemDefs (\ _lhsIoptions -> + (let _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + _hdOoptions :: Options + _tlOoptions :: Options + _hdIaroundInfos :: ([AroundInfo]) + _hdIaugmentInfos :: ([AugmentInfo]) + _hdIdefinedInsts :: ([Identifier]) + _hdIerrors :: (Seq Error) + _hdImergeInfos :: ([MergeInfo]) + _hdIorderDepsCollect :: (Set Dependency) + _hdIpragmaNamesCollect :: ([Identifier]) + _hdIruleInfos :: ([RuleInfo]) + _hdIsigInfos :: ([SigInfo]) + _hdIuniqueInfos :: ([UniqueInfo]) + _tlIaroundInfos :: ([AroundInfo]) + _tlIaugmentInfos :: ([AugmentInfo]) + _tlIdefinedInsts :: ([Identifier]) + _tlIerrors :: (Seq Error) + _tlImergeInfos :: ([MergeInfo]) + _tlIorderDepsCollect :: (Set Dependency) + _tlIpragmaNamesCollect :: ([Identifier]) + _tlIruleInfos :: ([RuleInfo]) + _tlIsigInfos :: ([SigInfo]) + _tlIuniqueInfos :: ([UniqueInfo]) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + _hdIaroundInfos ++ _tlIaroundInfos + {-# LINE 7049 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + _hdIaugmentInfos ++ _tlIaugmentInfos + {-# LINE 7055 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + _hdIdefinedInsts ++ _tlIdefinedInsts + {-# LINE 7061 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 7067 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + _hdImergeInfos ++ _tlImergeInfos + {-# LINE 7073 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect + {-# LINE 7079 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect + {-# LINE 7085 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + _hdIruleInfos ++ _tlIruleInfos + {-# LINE 7091 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + _hdIsigInfos ++ _tlIsigInfos + {-# LINE 7097 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + _hdIuniqueInfos ++ _tlIuniqueInfos + {-# LINE 7103 "Transform.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 7109 "Transform.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 39 "Transform.ag" #-} + _lhsIoptions + {-# LINE 7115 "Transform.hs" #-} + ) + ( _hdIaroundInfos,_hdIaugmentInfos,_hdIdefinedInsts,_hdIerrors,_hdImergeInfos,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos,_hdIuniqueInfos) = + hd_ _hdOoptions + ( _tlIaroundInfos,_tlIaugmentInfos,_tlIdefinedInsts,_tlIerrors,_tlImergeInfos,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos,_tlIuniqueInfos) = + tl_ _tlOoptions + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) +sem_SemDefs_Nil :: T_SemDefs +sem_SemDefs_Nil = + (T_SemDefs (\ _lhsIoptions -> + (let _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- use rule "Transform.ag"(line 1003, column 40) + _lhsOaroundInfos = + ({-# LINE 1003 "Transform.ag" #-} + [] + {-# LINE 7139 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1002, column 40) + _lhsOaugmentInfos = + ({-# LINE 1002 "Transform.ag" #-} + [] + {-# LINE 7145 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1084, column 55) + _lhsOdefinedInsts = + ({-# LINE 1084 "Transform.ag" #-} + [] + {-# LINE 7151 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 43, column 19) + _lhsOerrors = + ({-# LINE 43 "Transform.ag" #-} + Seq.empty + {-# LINE 7157 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1004, column 40) + _lhsOmergeInfos = + ({-# LINE 1004 "Transform.ag" #-} + [] + {-# LINE 7163 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 834, column 44) + _lhsOorderDepsCollect = + ({-# LINE 834 "Transform.ag" #-} + Set.empty + {-# LINE 7169 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 803, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 803 "Transform.ag" #-} + [] + {-# LINE 7175 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 999, column 40) + _lhsOruleInfos = + ({-# LINE 999 "Transform.ag" #-} + [] + {-# LINE 7181 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1000, column 40) + _lhsOsigInfos = + ({-# LINE 1000 "Transform.ag" #-} + [] + {-# LINE 7187 "Transform.hs" #-} + ) + -- use rule "Transform.ag"(line 1001, column 40) + _lhsOuniqueInfos = + ({-# LINE 1001 "Transform.ag" #-} + [] + {-# LINE 7193 "Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) diff --git a/src-derived/Visage.hs b/src-derived/Visage.hs new file mode 100644 --- /dev/null +++ b/src-derived/Visage.hs @@ -0,0 +1,768 @@ + + +-- UUAGC 0.9.38.1 (Visage.ag) +module Visage where +{-# LINE 6 "Visage.ag" #-} + +import UU.Scanner.Position(Pos(..)) +import CommonTypes +import ATermAbstractSyntax +import Expression +import VisagePatterns +import VisageSyntax +import qualified Data.Map as Map +import Data.Map(Map) +import Data.List(intersperse) +import TokenDef +{-# LINE 18 "../src-derived/Visage.hs" #-} + +{-# LINE 2 "./VisageSyntax.ag" #-} + +import CommonTypes +import UU.Pretty +import AbstractSyntax +import VisagePatterns +import Expression +{-# LINE 27 "../src-derived/Visage.hs" #-} + +{-# LINE 2 "./VisagePatterns.ag" #-} + +import UU.Scanner.Position(Pos) +import CommonTypes +{-# LINE 33 "../src-derived/Visage.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 39 "../src-derived/Visage.hs" #-} +{-# LINE 19 "Visage.ag" #-} + +convert :: String -> String +convert [] = [] +convert (c:ct) | c == '\n' = '\\' : 'n' : convert ct + | otherwise = c : convert ct + +sQ :: String -> String +sQ [] = [] +sQ (x:xs) = if (x=='"') then rest else x:rest + where + rest = if not (null xs) && last xs == '"' then init xs else xs + +showAGPos :: Pos -> String +showAGPos (Pos l c f) | l == (-1) = "" + | otherwise = let file = if null f then "" else f -- No show of f + lc = "(line " ++ show l ++ ", column " ++ show c ++")" + in file ++ lc + +showMap :: (Show a, Show b) => Map a b -> String +showMap + = braces . concat . intersperse "," . map (uncurry assign) . Map.assocs + where + braces s = "{" ++ s ++ "}" + assign a b = show a ++ ":=" ++ show b +{-# LINE 65 "../src-derived/Visage.hs" #-} +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = T_Expression (( ATerm)) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {aterm_Syn_Expression :: ATerm} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression ) = + (let ( _lhsOaterm) = sem + in (Syn_Expression _lhsOaterm )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOaterm :: ATerm + -- "Visage.ag"(line 103, column 17) + _lhsOaterm = + ({-# LINE 103 "Visage.ag" #-} + AAppl "Expression" [AString (sQ (showAGPos pos_)), AString (sQ (unlines . showTokens . tokensToStrings $ tks_))] + {-# LINE 100 "Visage.hs" #-} + ) + in ( _lhsOaterm)) ) +-- VisageChild ------------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VChild: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child rules : VisageRules +-} +-- cata +sem_VisageChild :: VisageChild -> + T_VisageChild +sem_VisageChild (VChild _name _tp _inh _syn _rules ) = + (sem_VisageChild_VChild _name _tp _inh _syn (sem_VisageRules _rules ) ) +-- semantic domain +newtype T_VisageChild = T_VisageChild (( ATerm)) +data Inh_VisageChild = Inh_VisageChild {} +data Syn_VisageChild = Syn_VisageChild {aterm_Syn_VisageChild :: ATerm} +wrap_VisageChild :: T_VisageChild -> + Inh_VisageChild -> + Syn_VisageChild +wrap_VisageChild (T_VisageChild sem ) (Inh_VisageChild ) = + (let ( _lhsOaterm) = sem + in (Syn_VisageChild _lhsOaterm )) +sem_VisageChild_VChild :: Identifier -> + Type -> + Attributes -> + Attributes -> + T_VisageRules -> + T_VisageChild +sem_VisageChild_VChild name_ tp_ inh_ syn_ (T_VisageRules rules_ ) = + (T_VisageChild (let _lhsOaterm :: ATerm + _rulesOisLoc :: Bool + _rulesIaterms :: ([ATerm]) + -- "Visage.ag"(line 85, column 18) + _lhsOaterm = + ({-# LINE 85 "Visage.ag" #-} + AAppl "Child" [AString (sQ (getName name_)), AString (sQ (show tp_)), + AString (sQ (showMap inh_)), + AString (sQ (showMap syn_)), + AAppl "Rules" _rulesIaterms] + {-# LINE 148 "Visage.hs" #-} + ) + -- "Visage.ag"(line 89, column 18) + _rulesOisLoc = + ({-# LINE 89 "Visage.ag" #-} + False + {-# LINE 154 "Visage.hs" #-} + ) + ( _rulesIaterms) = + rules_ _rulesOisLoc + in ( _lhsOaterm)) ) +-- VisageChildren ---------------------------------------------- +{- + visit 0: + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + child hd : VisageChild + child tl : VisageChildren + alternative Nil: +-} +-- cata +sem_VisageChildren :: VisageChildren -> + T_VisageChildren +sem_VisageChildren list = + (Prelude.foldr sem_VisageChildren_Cons sem_VisageChildren_Nil (Prelude.map sem_VisageChild list) ) +-- semantic domain +newtype T_VisageChildren = T_VisageChildren (( ([ATerm]))) +data Inh_VisageChildren = Inh_VisageChildren {} +data Syn_VisageChildren = Syn_VisageChildren {aterms_Syn_VisageChildren :: ([ATerm])} +wrap_VisageChildren :: T_VisageChildren -> + Inh_VisageChildren -> + Syn_VisageChildren +wrap_VisageChildren (T_VisageChildren sem ) (Inh_VisageChildren ) = + (let ( _lhsOaterms) = sem + in (Syn_VisageChildren _lhsOaterms )) +sem_VisageChildren_Cons :: T_VisageChild -> + T_VisageChildren -> + T_VisageChildren +sem_VisageChildren_Cons (T_VisageChild hd_ ) (T_VisageChildren tl_ ) = + (T_VisageChildren (let _lhsOaterms :: ([ATerm]) + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "Visage.ag"(line 80, column 17) + _lhsOaterms = + ({-# LINE 80 "Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 196 "Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ + ( _tlIaterms) = + tl_ + in ( _lhsOaterms)) ) +sem_VisageChildren_Nil :: T_VisageChildren +sem_VisageChildren_Nil = + (T_VisageChildren (let _lhsOaterms :: ([ATerm]) + -- "Visage.ag"(line 81, column 17) + _lhsOaterms = + ({-# LINE 81 "Visage.ag" #-} + [] + {-# LINE 210 "Visage.hs" #-} + ) + in ( _lhsOaterms)) ) +-- VisageGrammar ----------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VGrammar: + child nonts : VisageNonterminals +-} +-- cata +sem_VisageGrammar :: VisageGrammar -> + T_VisageGrammar +sem_VisageGrammar (VGrammar _nonts ) = + (sem_VisageGrammar_VGrammar (sem_VisageNonterminals _nonts ) ) +-- semantic domain +newtype T_VisageGrammar = T_VisageGrammar (( ATerm)) +data Inh_VisageGrammar = Inh_VisageGrammar {} +data Syn_VisageGrammar = Syn_VisageGrammar {aterm_Syn_VisageGrammar :: ATerm} +wrap_VisageGrammar :: T_VisageGrammar -> + Inh_VisageGrammar -> + Syn_VisageGrammar +wrap_VisageGrammar (T_VisageGrammar sem ) (Inh_VisageGrammar ) = + (let ( _lhsOaterm) = sem + in (Syn_VisageGrammar _lhsOaterm )) +sem_VisageGrammar_VGrammar :: T_VisageNonterminals -> + T_VisageGrammar +sem_VisageGrammar_VGrammar (T_VisageNonterminals nonts_ ) = + (T_VisageGrammar (let _lhsOaterm :: ATerm + _nontsIaterms :: ([ATerm]) + -- "Visage.ag"(line 54, column 18) + _lhsOaterm = + ({-# LINE 54 "Visage.ag" #-} + AAppl "Productions" _nontsIaterms + {-# LINE 246 "Visage.hs" #-} + ) + ( _nontsIaterms) = + nonts_ + in ( _lhsOaterm)) ) +-- VisageNonterminal ------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VNonterminal: + child nt : {NontermIdent} + child inh : {Attributes} + child syn : {Attributes} + child alts : VisageProductions +-} +-- cata +sem_VisageNonterminal :: VisageNonterminal -> + T_VisageNonterminal +sem_VisageNonterminal (VNonterminal _nt _inh _syn _alts ) = + (sem_VisageNonterminal_VNonterminal _nt _inh _syn (sem_VisageProductions _alts ) ) +-- semantic domain +newtype T_VisageNonterminal = T_VisageNonterminal (( ATerm)) +data Inh_VisageNonterminal = Inh_VisageNonterminal {} +data Syn_VisageNonterminal = Syn_VisageNonterminal {aterm_Syn_VisageNonterminal :: ATerm} +wrap_VisageNonterminal :: T_VisageNonterminal -> + Inh_VisageNonterminal -> + Syn_VisageNonterminal +wrap_VisageNonterminal (T_VisageNonterminal sem ) (Inh_VisageNonterminal ) = + (let ( _lhsOaterm) = sem + in (Syn_VisageNonterminal _lhsOaterm )) +sem_VisageNonterminal_VNonterminal :: NontermIdent -> + Attributes -> + Attributes -> + T_VisageProductions -> + T_VisageNonterminal +sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ (T_VisageProductions alts_ ) = + (T_VisageNonterminal (let _lhsOaterm :: ATerm + _altsIaterms :: ([ATerm]) + -- "Visage.ag"(line 63, column 19) + _lhsOaterm = + ({-# LINE 63 "Visage.ag" #-} + AAppl "Production" [AString (sQ (getName nt_)), AString (sQ(showMap inh_)), + AString (sQ(showMap syn_)), AAppl "Alternatives" _altsIaterms] + {-# LINE 291 "Visage.hs" #-} + ) + ( _altsIaterms) = + alts_ + in ( _lhsOaterm)) ) +-- VisageNonterminals ------------------------------------------ +{- + visit 0: + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + child hd : VisageNonterminal + child tl : VisageNonterminals + alternative Nil: +-} +-- cata +sem_VisageNonterminals :: VisageNonterminals -> + T_VisageNonterminals +sem_VisageNonterminals list = + (Prelude.foldr sem_VisageNonterminals_Cons sem_VisageNonterminals_Nil (Prelude.map sem_VisageNonterminal list) ) +-- semantic domain +newtype T_VisageNonterminals = T_VisageNonterminals (( ([ATerm]))) +data Inh_VisageNonterminals = Inh_VisageNonterminals {} +data Syn_VisageNonterminals = Syn_VisageNonterminals {aterms_Syn_VisageNonterminals :: ([ATerm])} +wrap_VisageNonterminals :: T_VisageNonterminals -> + Inh_VisageNonterminals -> + Syn_VisageNonterminals +wrap_VisageNonterminals (T_VisageNonterminals sem ) (Inh_VisageNonterminals ) = + (let ( _lhsOaterms) = sem + in (Syn_VisageNonterminals _lhsOaterms )) +sem_VisageNonterminals_Cons :: T_VisageNonterminal -> + T_VisageNonterminals -> + T_VisageNonterminals +sem_VisageNonterminals_Cons (T_VisageNonterminal hd_ ) (T_VisageNonterminals tl_ ) = + (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "Visage.ag"(line 58, column 17) + _lhsOaterms = + ({-# LINE 58 "Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 333 "Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ + ( _tlIaterms) = + tl_ + in ( _lhsOaterms)) ) +sem_VisageNonterminals_Nil :: T_VisageNonterminals +sem_VisageNonterminals_Nil = + (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) + -- "Visage.ag"(line 59, column 17) + _lhsOaterms = + ({-# LINE 59 "Visage.ag" #-} + [] + {-# LINE 347 "Visage.hs" #-} + ) + in ( _lhsOaterms)) ) +-- VisagePattern ----------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VAlias: + child field : {Identifier} + child attr : {Identifier} + child pat : VisagePattern + alternative VConstr: + child name : {ConstructorIdent} + child pats : VisagePatterns + alternative VProduct: + child pos : {Pos} + child pats : VisagePatterns + alternative VUnderscore: + child pos : {Pos} + alternative VVar: + child field : {Identifier} + child attr : {Identifier} +-} +-- cata +sem_VisagePattern :: VisagePattern -> + T_VisagePattern +sem_VisagePattern (VAlias _field _attr _pat ) = + (sem_VisagePattern_VAlias _field _attr (sem_VisagePattern _pat ) ) +sem_VisagePattern (VConstr _name _pats ) = + (sem_VisagePattern_VConstr _name (sem_VisagePatterns _pats ) ) +sem_VisagePattern (VProduct _pos _pats ) = + (sem_VisagePattern_VProduct _pos (sem_VisagePatterns _pats ) ) +sem_VisagePattern (VUnderscore _pos ) = + (sem_VisagePattern_VUnderscore _pos ) +sem_VisagePattern (VVar _field _attr ) = + (sem_VisagePattern_VVar _field _attr ) +-- semantic domain +newtype T_VisagePattern = T_VisagePattern (( ATerm)) +data Inh_VisagePattern = Inh_VisagePattern {} +data Syn_VisagePattern = Syn_VisagePattern {aterm_Syn_VisagePattern :: ATerm} +wrap_VisagePattern :: T_VisagePattern -> + Inh_VisagePattern -> + Syn_VisagePattern +wrap_VisagePattern (T_VisagePattern sem ) (Inh_VisagePattern ) = + (let ( _lhsOaterm) = sem + in (Syn_VisagePattern _lhsOaterm )) +sem_VisagePattern_VAlias :: Identifier -> + Identifier -> + T_VisagePattern -> + T_VisagePattern +sem_VisagePattern_VAlias field_ attr_ (T_VisagePattern pat_ ) = + (T_VisagePattern (let _lhsOaterm :: ATerm + _patIaterm :: ATerm + -- "Visage.ag"(line 119, column 18) + _lhsOaterm = + ({-# LINE 119 "Visage.ag" #-} + AAppl "Pattern" [AAppl "Alias" [AString (sQ (showAGPos (getPos field_))), + AString (sQ (getName field_ ++ "." ++ getName attr_)), _patIaterm]] + {-# LINE 407 "Visage.hs" #-} + ) + ( _patIaterm) = + pat_ + in ( _lhsOaterm)) ) +sem_VisagePattern_VConstr :: ConstructorIdent -> + T_VisagePatterns -> + T_VisagePattern +sem_VisagePattern_VConstr name_ (T_VisagePatterns pats_ ) = + (T_VisagePattern (let _lhsOaterm :: ATerm + _patsIaterms :: ([ATerm]) + -- "Visage.ag"(line 112, column 18) + _lhsOaterm = + ({-# LINE 112 "Visage.ag" #-} + AAppl "Pattern" [AAppl "Constr" [AString (sQ (showAGPos (getPos name_))), + AString (sQ (getName name_)), + AAppl "Patterns" _patsIaterms]] + {-# LINE 424 "Visage.hs" #-} + ) + ( _patsIaterms) = + pats_ + in ( _lhsOaterm)) ) +sem_VisagePattern_VProduct :: Pos -> + T_VisagePatterns -> + T_VisagePattern +sem_VisagePattern_VProduct pos_ (T_VisagePatterns pats_ ) = + (T_VisagePattern (let _lhsOaterm :: ATerm + _patsIaterms :: ([ATerm]) + -- "Visage.ag"(line 115, column 18) + _lhsOaterm = + ({-# LINE 115 "Visage.ag" #-} + AAppl "Pattern" [AAppl "Product" [AString (sQ (showAGPos pos_)), + AAppl "Patterns" _patsIaterms]] + {-# LINE 440 "Visage.hs" #-} + ) + ( _patsIaterms) = + pats_ + in ( _lhsOaterm)) ) +sem_VisagePattern_VUnderscore :: Pos -> + T_VisagePattern +sem_VisagePattern_VUnderscore pos_ = + (T_VisagePattern (let _lhsOaterm :: ATerm + -- "Visage.ag"(line 121, column 18) + _lhsOaterm = + ({-# LINE 121 "Visage.ag" #-} + AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos pos_))]] + {-# LINE 453 "Visage.hs" #-} + ) + in ( _lhsOaterm)) ) +sem_VisagePattern_VVar :: Identifier -> + Identifier -> + T_VisagePattern +sem_VisagePattern_VVar field_ attr_ = + (T_VisagePattern (let _lhsOaterm :: ATerm + -- "Visage.ag"(line 117, column 18) + _lhsOaterm = + ({-# LINE 117 "Visage.ag" #-} + AAppl "Pattern" [AAppl "Var" [AString (sQ (showAGPos (getPos field_))), + AString (sQ (getName field_ ++ "." ++ getName attr_))]] + {-# LINE 466 "Visage.hs" #-} + ) + in ( _lhsOaterm)) ) +-- VisagePatterns ---------------------------------------------- +{- + visit 0: + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + child hd : VisagePattern + child tl : VisagePatterns + alternative Nil: +-} +-- cata +sem_VisagePatterns :: VisagePatterns -> + T_VisagePatterns +sem_VisagePatterns list = + (Prelude.foldr sem_VisagePatterns_Cons sem_VisagePatterns_Nil (Prelude.map sem_VisagePattern list) ) +-- semantic domain +newtype T_VisagePatterns = T_VisagePatterns (( ([ATerm]))) +data Inh_VisagePatterns = Inh_VisagePatterns {} +data Syn_VisagePatterns = Syn_VisagePatterns {aterms_Syn_VisagePatterns :: ([ATerm])} +wrap_VisagePatterns :: T_VisagePatterns -> + Inh_VisagePatterns -> + Syn_VisagePatterns +wrap_VisagePatterns (T_VisagePatterns sem ) (Inh_VisagePatterns ) = + (let ( _lhsOaterms) = sem + in (Syn_VisagePatterns _lhsOaterms )) +sem_VisagePatterns_Cons :: T_VisagePattern -> + T_VisagePatterns -> + T_VisagePatterns +sem_VisagePatterns_Cons (T_VisagePattern hd_ ) (T_VisagePatterns tl_ ) = + (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "Visage.ag"(line 107, column 17) + _lhsOaterms = + ({-# LINE 107 "Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 506 "Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ + ( _tlIaterms) = + tl_ + in ( _lhsOaterms)) ) +sem_VisagePatterns_Nil :: T_VisagePatterns +sem_VisagePatterns_Nil = + (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) + -- "Visage.ag"(line 108, column 17) + _lhsOaterms = + ({-# LINE 108 "Visage.ag" #-} + [] + {-# LINE 520 "Visage.hs" #-} + ) + in ( _lhsOaterms)) ) +-- VisageProduction -------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VProduction: + child con : {ConstructorIdent} + child children : VisageChildren + child rules : VisageRules + child locrules : VisageRules +-} +-- cata +sem_VisageProduction :: VisageProduction -> + T_VisageProduction +sem_VisageProduction (VProduction _con _children _rules _locrules ) = + (sem_VisageProduction_VProduction _con (sem_VisageChildren _children ) (sem_VisageRules _rules ) (sem_VisageRules _locrules ) ) +-- semantic domain +newtype T_VisageProduction = T_VisageProduction (( ATerm)) +data Inh_VisageProduction = Inh_VisageProduction {} +data Syn_VisageProduction = Syn_VisageProduction {aterm_Syn_VisageProduction :: ATerm} +wrap_VisageProduction :: T_VisageProduction -> + Inh_VisageProduction -> + Syn_VisageProduction +wrap_VisageProduction (T_VisageProduction sem ) (Inh_VisageProduction ) = + (let ( _lhsOaterm) = sem + in (Syn_VisageProduction _lhsOaterm )) +sem_VisageProduction_VProduction :: ConstructorIdent -> + T_VisageChildren -> + T_VisageRules -> + T_VisageRules -> + T_VisageProduction +sem_VisageProduction_VProduction con_ (T_VisageChildren children_ ) (T_VisageRules rules_ ) (T_VisageRules locrules_ ) = + (T_VisageProduction (let _lhsOaterm :: ATerm + _locrulesOisLoc :: Bool + _rulesOisLoc :: Bool + _childrenIaterms :: ([ATerm]) + _rulesIaterms :: ([ATerm]) + _locrulesIaterms :: ([ATerm]) + -- "Visage.ag"(line 73, column 17) + _lhsOaterm = + ({-# LINE 73 "Visage.ag" #-} + AAppl "Alternative" [AString (sQ (getName con_)), AAppl "Children" _childrenIaterms, + AAppl "Rules" _rulesIaterms, + AAppl "LocRules" _locrulesIaterms] + {-# LINE 568 "Visage.hs" #-} + ) + -- "Visage.ag"(line 76, column 18) + _locrulesOisLoc = + ({-# LINE 76 "Visage.ag" #-} + True + {-# LINE 574 "Visage.hs" #-} + ) + -- "Visage.ag"(line 77, column 18) + _rulesOisLoc = + ({-# LINE 77 "Visage.ag" #-} + False + {-# LINE 580 "Visage.hs" #-} + ) + ( _childrenIaterms) = + children_ + ( _rulesIaterms) = + rules_ _rulesOisLoc + ( _locrulesIaterms) = + locrules_ _locrulesOisLoc + in ( _lhsOaterm)) ) +-- VisageProductions ------------------------------------------- +{- + visit 0: + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + child hd : VisageProduction + child tl : VisageProductions + alternative Nil: +-} +-- cata +sem_VisageProductions :: VisageProductions -> + T_VisageProductions +sem_VisageProductions list = + (Prelude.foldr sem_VisageProductions_Cons sem_VisageProductions_Nil (Prelude.map sem_VisageProduction list) ) +-- semantic domain +newtype T_VisageProductions = T_VisageProductions (( ([ATerm]))) +data Inh_VisageProductions = Inh_VisageProductions {} +data Syn_VisageProductions = Syn_VisageProductions {aterms_Syn_VisageProductions :: ([ATerm])} +wrap_VisageProductions :: T_VisageProductions -> + Inh_VisageProductions -> + Syn_VisageProductions +wrap_VisageProductions (T_VisageProductions sem ) (Inh_VisageProductions ) = + (let ( _lhsOaterms) = sem + in (Syn_VisageProductions _lhsOaterms )) +sem_VisageProductions_Cons :: T_VisageProduction -> + T_VisageProductions -> + T_VisageProductions +sem_VisageProductions_Cons (T_VisageProduction hd_ ) (T_VisageProductions tl_ ) = + (T_VisageProductions (let _lhsOaterms :: ([ATerm]) + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "Visage.ag"(line 68, column 17) + _lhsOaterms = + ({-# LINE 68 "Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 626 "Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ + ( _tlIaterms) = + tl_ + in ( _lhsOaterms)) ) +sem_VisageProductions_Nil :: T_VisageProductions +sem_VisageProductions_Nil = + (T_VisageProductions (let _lhsOaterms :: ([ATerm]) + -- "Visage.ag"(line 69, column 17) + _lhsOaterms = + ({-# LINE 69 "Visage.ag" #-} + [] + {-# LINE 640 "Visage.hs" #-} + ) + in ( _lhsOaterms)) ) +-- VisageRule -------------------------------------------------- +{- + visit 0: + inherited attribute: + isLoc : Bool + synthesized attribute: + aterm : ATerm + alternatives: + alternative VRule: + child fieldattrs : {[(Identifier,Identifier)]} + child attr : {Identifier} + child pat : VisagePattern + child rhs : Expression + child owrt : {Bool} +-} +-- cata +sem_VisageRule :: VisageRule -> + T_VisageRule +sem_VisageRule (VRule _fieldattrs _attr _pat _rhs _owrt ) = + (sem_VisageRule_VRule _fieldattrs _attr (sem_VisagePattern _pat ) (sem_Expression _rhs ) _owrt ) +-- semantic domain +newtype T_VisageRule = T_VisageRule (Bool -> + ( ATerm)) +data Inh_VisageRule = Inh_VisageRule {isLoc_Inh_VisageRule :: Bool} +data Syn_VisageRule = Syn_VisageRule {aterm_Syn_VisageRule :: ATerm} +wrap_VisageRule :: T_VisageRule -> + Inh_VisageRule -> + Syn_VisageRule +wrap_VisageRule (T_VisageRule sem ) (Inh_VisageRule _lhsIisLoc ) = + (let ( _lhsOaterm) = sem _lhsIisLoc + in (Syn_VisageRule _lhsOaterm )) +sem_VisageRule_VRule :: ([(Identifier,Identifier)]) -> + Identifier -> + T_VisagePattern -> + T_Expression -> + Bool -> + T_VisageRule +sem_VisageRule_VRule fieldattrs_ attr_ (T_VisagePattern pat_ ) (T_Expression rhs_ ) owrt_ = + (T_VisageRule (\ _lhsIisLoc -> + (let _lhsOaterm :: ATerm + _patIaterm :: ATerm + _rhsIaterm :: ATerm + -- "Visage.ag"(line 97, column 18) + _lhsOaterm = + ({-# LINE 97 "Visage.ag" #-} + AAppl (if _lhsIisLoc then "LocRule" else "Rule") + ([AString (sQ (getName attr_)), _patIaterm, _rhsIaterm] ++ if _lhsIisLoc then [AString (sQ (show owrt_))] else []) + {-# LINE 690 "Visage.hs" #-} + ) + ( _patIaterm) = + pat_ + ( _rhsIaterm) = + rhs_ + in ( _lhsOaterm))) ) +-- VisageRules ------------------------------------------------- +{- + visit 0: + inherited attribute: + isLoc : Bool + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + child hd : VisageRule + child tl : VisageRules + alternative Nil: +-} +-- cata +sem_VisageRules :: VisageRules -> + T_VisageRules +sem_VisageRules list = + (Prelude.foldr sem_VisageRules_Cons sem_VisageRules_Nil (Prelude.map sem_VisageRule list) ) +-- semantic domain +newtype T_VisageRules = T_VisageRules (Bool -> + ( ([ATerm]))) +data Inh_VisageRules = Inh_VisageRules {isLoc_Inh_VisageRules :: Bool} +data Syn_VisageRules = Syn_VisageRules {aterms_Syn_VisageRules :: ([ATerm])} +wrap_VisageRules :: T_VisageRules -> + Inh_VisageRules -> + Syn_VisageRules +wrap_VisageRules (T_VisageRules sem ) (Inh_VisageRules _lhsIisLoc ) = + (let ( _lhsOaterms) = sem _lhsIisLoc + in (Syn_VisageRules _lhsOaterms )) +sem_VisageRules_Cons :: T_VisageRule -> + T_VisageRules -> + T_VisageRules +sem_VisageRules_Cons (T_VisageRule hd_ ) (T_VisageRules tl_ ) = + (T_VisageRules (\ _lhsIisLoc -> + (let _lhsOaterms :: ([ATerm]) + _hdOisLoc :: Bool + _tlOisLoc :: Bool + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "Visage.ag"(line 92, column 17) + _lhsOaterms = + ({-# LINE 92 "Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 740 "Visage.hs" #-} + ) + -- copy rule (down) + _hdOisLoc = + ({-# LINE 51 "Visage.ag" #-} + _lhsIisLoc + {-# LINE 746 "Visage.hs" #-} + ) + -- copy rule (down) + _tlOisLoc = + ({-# LINE 51 "Visage.ag" #-} + _lhsIisLoc + {-# LINE 752 "Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ _hdOisLoc + ( _tlIaterms) = + tl_ _tlOisLoc + in ( _lhsOaterms))) ) +sem_VisageRules_Nil :: T_VisageRules +sem_VisageRules_Nil = + (T_VisageRules (\ _lhsIisLoc -> + (let _lhsOaterms :: ([ATerm]) + -- "Visage.ag"(line 93, column 17) + _lhsOaterms = + ({-# LINE 93 "Visage.ag" #-} + [] + {-# LINE 767 "Visage.hs" #-} + ) + in ( _lhsOaterms))) ) diff --git a/src-derived/VisagePatterns.hs b/src-derived/VisagePatterns.hs new file mode 100644 --- /dev/null +++ b/src-derived/VisagePatterns.hs @@ -0,0 +1,42 @@ + + +-- UUAGC 0.9.38.1 (VisagePatterns.ag) +module VisagePatterns where +{-# LINE 2 "VisagePatterns.ag" #-} + +import UU.Scanner.Position(Pos) +import CommonTypes +{-# LINE 10 "../src-derived/VisagePatterns.hs" #-} +-- VisagePattern ----------------------------------------------- +{- + alternatives: + alternative VAlias: + child field : {Identifier} + child attr : {Identifier} + child pat : VisagePattern + alternative VConstr: + child name : {ConstructorIdent} + child pats : VisagePatterns + alternative VProduct: + child pos : {Pos} + child pats : VisagePatterns + alternative VUnderscore: + child pos : {Pos} + alternative VVar: + child field : {Identifier} + child attr : {Identifier} +-} +data VisagePattern = VAlias (Identifier) (Identifier) (VisagePattern ) + | VConstr (ConstructorIdent) (VisagePatterns ) + | VProduct (Pos) (VisagePatterns ) + | VUnderscore (Pos) + | VVar (Identifier) (Identifier) +-- VisagePatterns ---------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisagePattern + child tl : VisagePatterns + alternative Nil: +-} +type VisagePatterns = [VisagePattern ] diff --git a/src-derived/VisageSyntax.hs b/src-derived/VisageSyntax.hs new file mode 100644 --- /dev/null +++ b/src-derived/VisageSyntax.hs @@ -0,0 +1,97 @@ + + +-- UUAGC 0.9.38.1 (VisageSyntax.ag) +module VisageSyntax where +{-# LINE 2 "VisageSyntax.ag" #-} + +import CommonTypes +import UU.Pretty +import AbstractSyntax +import VisagePatterns +import Expression +{-# LINE 13 "../src-derived/VisageSyntax.hs" #-} +-- VisageChild ------------------------------------------------- +{- + alternatives: + alternative VChild: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child rules : VisageRules +-} +data VisageChild = VChild (Identifier) (Type) (Attributes) (Attributes) (VisageRules ) +-- VisageChildren ---------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisageChild + child tl : VisageChildren + alternative Nil: +-} +type VisageChildren = [VisageChild ] +-- VisageGrammar ----------------------------------------------- +{- + alternatives: + alternative VGrammar: + child nonts : VisageNonterminals +-} +data VisageGrammar = VGrammar (VisageNonterminals ) +-- VisageNonterminal ------------------------------------------- +{- + alternatives: + alternative VNonterminal: + child nt : {NontermIdent} + child inh : {Attributes} + child syn : {Attributes} + child alts : VisageProductions +-} +data VisageNonterminal = VNonterminal (NontermIdent) (Attributes) (Attributes) (VisageProductions ) +-- VisageNonterminals ------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : VisageNonterminal + child tl : VisageNonterminals + alternative Nil: +-} +type VisageNonterminals = [VisageNonterminal ] +-- VisageProduction -------------------------------------------- +{- + alternatives: + alternative VProduction: + child con : {ConstructorIdent} + child children : VisageChildren + child rules : VisageRules + child locrules : VisageRules +-} +data VisageProduction = VProduction (ConstructorIdent) (VisageChildren ) (VisageRules ) (VisageRules ) +-- VisageProductions ------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisageProduction + child tl : VisageProductions + alternative Nil: +-} +type VisageProductions = [VisageProduction ] +-- VisageRule -------------------------------------------------- +{- + alternatives: + alternative VRule: + child fieldattrs : {[(Identifier,Identifier)]} + child attr : {Identifier} + child pat : {VisagePattern} + child rhs : {Expression} + child owrt : {Bool} +-} +data VisageRule = VRule (([(Identifier,Identifier)])) (Identifier) (VisagePattern) (Expression) (Bool) +-- VisageRules ------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisageRule + child tl : VisageRules + alternative Nil: +-} +type VisageRules = [VisageRule ] diff --git a/src/ATermAbstractSyntax.hs b/src/ATermAbstractSyntax.hs new file mode 100644 --- /dev/null +++ b/src/ATermAbstractSyntax.hs @@ -0,0 +1,23 @@ +{----------------------------------------------------------------------------- + + Haskell ATerm Library + + Joost Visser + CWI, Amsterdam + + This module is part of the ATerm library for Haskell. It defines the + abstract syntax of ATerms as a Haskell datatype. + +------------------------------------------------------------------------------} + +module ATermAbstractSyntax where + +-- Abstract syntax ----------------------------------------------------------- + +data ATerm = AAppl String [ATerm] + | AList [ATerm] + | AInt Integer + | AString String + deriving (Read,Show,Eq,Ord) + +------------------------------------------------------------------------------ diff --git a/src/ATermWrite.hs b/src/ATermWrite.hs new file mode 100644 --- /dev/null +++ b/src/ATermWrite.hs @@ -0,0 +1,24 @@ +module ATermWrite where + +import ATermAbstractSyntax + +writeATerm t = writeAT 0 t + +writeAT :: Int -> ATerm -> String +writeAT n (AAppl c ts) = (if (n > 0) then "\n" else "") + ++ replicate n ' ' + ++ writeATermAux c (map (writeAT (n+2)) ts) +writeAT n (AList ts) = bracket (commaSep (map (writeAT n) ts)) +writeAT n (AInt i) = show i +writeAT n (AString s) = quote s + +writeATermAux c [] = c++(parenthesise "") +writeATermAux c ts = c++(parenthesise (commaSep ts)) + +sepBy sep (x:y:ys) = x:sep:sepBy sep (y:ys) +sepBy sep ys = ys + +commaSep strs = concat (sepBy "," strs) +bracket str = "["++str++"]" +parenthesise str = "("++str++")" +quote str = "\""++str++"\"" diff --git a/src/Ag.hs b/src/Ag.hs new file mode 100644 --- /dev/null +++ b/src/Ag.hs @@ -0,0 +1,364 @@ +module Main where + +import System (getArgs, getProgName, exitFailure) +import System.Console.GetOpt (usageInfo) +import List (isSuffixOf,nub) +import Monad (zipWithM_) +import Data.Maybe + +import qualified Data.Set as Set +import qualified Data.Map as Map +import qualified Data.Sequence as Seq ((><)) +import Data.Foldable(toList) +import Pretty + +import UU.Parsing (Message(..), Action(..)) +import UU.Scanner.Position (Pos, line, file) +import UU.Scanner.Token (Token) + +import qualified Transform as Pass1 (sem_AG , wrap_AG , Syn_AG (..), Inh_AG (..)) +import qualified Desugar as Pass1a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) +import qualified DefaultRules as Pass2 (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) +import qualified Order as Pass3 (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) +import qualified KWOrder as Pass3a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) +import qualified GenerateCode as Pass4 (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) +import qualified PrintVisitCode as Pass4a (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) +import qualified ExecutionPlan2Hs as Pass4b (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..)) +import qualified PrintCode as Pass5 (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) +import qualified PrintOcamlCode as Pass5a (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) +import qualified PrintErrorMessages as PrErr (sem_Errors , wrap_Errors , Syn_Errors (..), Inh_Errors (..), isError) +import qualified TfmToVisage as PassV (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) + +import qualified AbstractSyntaxDump as GrammarDump (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) +import qualified CodeSyntaxDump as CGrammarDump (sem_CGrammar, wrap_CGrammar, Syn_CGrammar (..), Inh_CGrammar (..)) +import qualified Visage as VisageDump (sem_VisageGrammar, wrap_VisageGrammar, Syn_VisageGrammar(..), Inh_VisageGrammar(..)) +import qualified AG2AspectAG as AspectAGDump (pragmaAspectAG, importAspectAG, sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) --marcos + +import Options +import Version (banner) +import Parser (parseAG, depsAG) +import ErrorMessages (Error(ParserError), Errors) +import CommonTypes +import ATermWrite + + +main :: IO () +main + = do args <- getArgs + progName <- getProgName + + let usageheader = "Usage info:\n " ++ progName ++ " options file ...\n\nList of options:" + (flags,files,errs) = getOptions args + + if showVersion flags + then putStrLn banner + else if null files || showHelp flags || (not.null) errs + then mapM_ putStrLn (usageInfo usageheader options : errs) + else if genFileDeps flags + then reportDeps flags files + else zipWithM_ (compile flags) files (outputFiles flags++repeat "") + + +compile :: Options -> String -> String -> IO () +compile flags input output + = do (output0,parseErrors) <- parseAG flags (searchPath flags) (inputFile input) + irrefutableMap <- readIrrefutableMap flags + + let output1 = Pass1.wrap_AG (Pass1.sem_AG output0 ) Pass1.Inh_AG {Pass1.options_Inh_AG = flags} + flags' = Pass1.pragmas_Syn_AG output1 $ flags + grammar1 = Pass1.output_Syn_AG output1 + output1a = Pass1a.wrap_Grammar (Pass1a.sem_Grammar grammar1 ) Pass1a.Inh_Grammar {Pass1a.options_Inh_Grammar = flags', Pass1a.forcedIrrefutables_Inh_Grammar = irrefutableMap } + grammar1a =Pass1a.output_Syn_Grammar output1a + output2 = Pass2.wrap_Grammar (Pass2.sem_Grammar grammar1a ) Pass2.Inh_Grammar {Pass2.options_Inh_Grammar = flags'} + grammar2 = Pass2.output_Syn_Grammar output2 + outputV = PassV.wrap_Grammar (PassV.sem_Grammar grammar2 ) PassV.Inh_Grammar {} + grammarV = PassV.visage_Syn_Grammar outputV + output3 = Pass3.wrap_Grammar (Pass3.sem_Grammar grammar2 ) Pass3.Inh_Grammar {Pass3.options_Inh_Grammar = flags'} + grammar3 = Pass3.output_Syn_Grammar output3 + output3a = Pass3a.wrap_Grammar (Pass3a.sem_Grammar grammar2 ) Pass3a.Inh_Grammar {Pass3a.options_Inh_Grammar = flags'} + grammar3a = Pass3a.output_Syn_Grammar output3a + output4 = Pass4.wrap_CGrammar (Pass4.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4.Inh_CGrammar {Pass4.options_Inh_CGrammar = flags'} + output4a = Pass4a.wrap_CGrammar (Pass4a.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4a.Inh_CGrammar {Pass4a.options_Inh_CGrammar = flags'} + output4b = Pass4b.wrap_ExecutionPlan (Pass4b.sem_ExecutionPlan grammar3a) Pass4b.Inh_ExecutionPlan {Pass4b.options_Inh_ExecutionPlan = flags', Pass4b.inhmap_Inh_ExecutionPlan = Pass3a.inhmap_Syn_Grammar output3a, Pass4b.synmap_Inh_ExecutionPlan = Pass3a.synmap_Syn_Grammar output3a, Pass4b.pragmaBlocks_Inh_ExecutionPlan = pragmaBlocksTxt, Pass4b.importBlocks_Inh_ExecutionPlan = importBlocksTxt, Pass4b.textBlocks_Inh_ExecutionPlan = textBlocksDoc, Pass4b.moduleHeader_Inh_ExecutionPlan = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass4b.mainName_Inh_ExecutionPlan = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1} + debug4b = Pass4b.debugoutput_Syn_ExecutionPlan output4b + output5 = Pass5.wrap_Program (Pass5.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5.Inh_Program {Pass5.options_Inh_Program = flags', Pass5.pragmaBlocks_Inh_Program = pragmaBlocksTxt, Pass5.importBlocks_Inh_Program = importBlocksTxt, Pass5.textBlocks_Inh_Program = textBlocksDoc, Pass5.textBlockMap_Inh_Program = textBlockMap, Pass5.optionsLine_Inh_Program = optionsLine, Pass5.mainFile_Inh_Program = mainFile, Pass5.moduleHeader_Inh_Program = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass5.mainName_Inh_Program = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1} + output5a = Pass5a.wrap_Program (Pass5a.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5a.Inh_Program { Pass5a.options_Inh_Program = flags', Pass5a.textBlockMap_Inh_Program = textBlockMap } + output6 = PrErr.wrap_Errors (PrErr.sem_Errors errorsToReport) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags', PrErr.dups_Inh_Errors = [] } + + dump1 = GrammarDump.wrap_Grammar (GrammarDump.sem_Grammar grammar1 ) GrammarDump.Inh_Grammar + dump2 = GrammarDump.wrap_Grammar (GrammarDump.sem_Grammar grammar2 ) GrammarDump.Inh_Grammar + dump3 = CGrammarDump.wrap_CGrammar (CGrammarDump.sem_CGrammar grammar3 ) CGrammarDump.Inh_CGrammar + + aspectAG = AspectAGDump.wrap_Grammar (AspectAGDump.sem_Grammar grammar2 ) AspectAGDump.Inh_Grammar {AspectAGDump.options_Inh_Grammar = flags'} --marcos + + outputVisage = VisageDump.wrap_VisageGrammar (VisageDump.sem_VisageGrammar grammarV) VisageDump.Inh_VisageGrammar + aterm = VisageDump.aterm_Syn_VisageGrammar outputVisage + + parseErrorList = map message2error parseErrors + mainErrors = toList ( Pass1.errors_Syn_AG output1 + Seq.>< Pass1a.errors_Syn_Grammar output1a + Seq.>< Pass2.errors_Syn_Grammar output2 ) + furtherErrors = if kennedyWarren flags' then [] + else toList ( Pass3.errors_Syn_Grammar output3 + Seq.>< Pass4.errors_Syn_CGrammar output4) + + errorList = if null parseErrorList + then mainErrors + ++ if null mainErrors || null (filter (PrErr.isError flags') mainErrors) + then furtherErrors + else [] + else [head parseErrorList] + + fatalErrorList = filter (PrErr.isError flags') errorList + + allErrors = if wignore flags' + then fatalErrorList + else errorsToFront flags' errorList + + errorsToReport = take (wmaxerrs flags') allErrors + + errorsToStopOn = if werrors flags' + then errorList + else fatalErrorList + + blocks1 = (Pass1.blocks_Syn_AG output1) {-SM `Map.unionWith (++)` (Pass3.blocks_Syn_Grammar output3)-} + (pragmaBlocks, blocks2) = Map.partitionWithKey (\(k, at) _->k==BlockPragma && at == Nothing) blocks1 + (importBlocks, textBlocks) = Map.partitionWithKey (\(k, at) _->k==BlockImport && at == Nothing) blocks2 + + importBlocksTxt = vlist_sep "" . map addLocationPragma . concat . Map.elems $ importBlocks + textBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockOther, Nothing) $ textBlocks + pragmaBlocksTxt = unlines . concat . map fst . concat . Map.elems $ pragmaBlocks + textBlockMap = Map.map (vlist_sep "" . map addLocationPragma) . Map.filterWithKey (\(_, at) _ -> at /= Nothing) $ textBlocks + + outputfile = if null output then outputFile input else output + + addLocationPragma :: ([String], Pos) -> PP_Doc + addLocationPragma (strs, p) + | genLinePragmas flags' + = "{-# LINE" >#< pp (show (line p)) >#< show (file p) >#< "#-}" >-< vlist (map pp strs) >-< "{-# LINE" >#< ppWithLineNr (pp.show.(+1)) >#< show outputfile >#< "#-}" + | otherwise + = vlist (map pp strs) + + optionsGHC = option (unbox flags') "-fglasgow-exts" ++ option (bangpats flags') "-XBangPatterns" + option True s = [s] + option False _ = [] + optionsLine | null optionsGHC = "" + | otherwise = "{-# OPTIONS_GHC " ++ unwords optionsGHC ++ " #-}" + + mainName = stripPath $ defaultModuleName input + mainFile = defaultModuleName input + + nrOfErrorsToReport = length $ filter (PrErr.isError flags') errorsToReport + nrOfWarningsToReport = length $ filter (not.(PrErr.isError flags')) errorsToReport + totalNrOfErrors = length $ filter (PrErr.isError flags') allErrors + totalNrOfWarnings = length $ filter (not.(PrErr.isError flags')) allErrors + additionalErrors = totalNrOfErrors - nrOfErrorsToReport + additionalWarnings = totalNrOfWarnings - nrOfWarningsToReport + pluralS n = if n == 1 then "" else "s" + + putStr . formatErrors $ PrErr.pp_Syn_Errors output6 + + if additionalErrors > 0 + then putStr $ "\nPlus " ++ show additionalErrors ++ " more error" ++ pluralS additionalErrors ++ + if additionalWarnings > 0 + then " and " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" + else ".\n" + else if additionalWarnings > 0 + then putStr $ "\nPlus " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" + else return () + + if not (null fatalErrorList) + then exitFailure + else + do + if genvisage flags' + then writeFile (outputfile++".visage") (writeATerm aterm) + else return () + + if genAttributeList flags' + then writeAttributeList (outputfile++".attrs") (Pass1a.allAttributes_Syn_Grammar output1a) + else return () + + if sepSemMods flags' + then do -- alternative module gen + Pass5.genIO_Syn_Program output5 + if not (null errorsToStopOn) then exitFailure else return () + else do -- conventional module gen + let doc + | visitorsOutput flags' + = vlist [ pp_braces importBlocksTxt + , pp_braces textBlocksDoc + , vlist $ Pass4a.output_Syn_CGrammar output4a + ] + -- marcos AspectAG gen + | genAspectAG flags' + = vlist [ AspectAGDump.pragmaAspectAG + , vlist ( [ pp optionsLine + , pp pragmaBlocksTxt + , pp $ take 70 ("-- UUAGC2AspectAG " ++ drop 50 banner ++ " (" ++ input) ++ ")" + , pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 + then moduleHeader flags' mainName + else mkModuleHeader (Pass1.moduleDecl_Syn_AG output1) mainName "" "" False + ] + ) + , pp importBlocksTxt + , AspectAGDump.importAspectAG + , textBlocksDoc + , pp "\n\n{-- AspectAG Code --}\n\n" + + , AspectAGDump.pp_Syn_Grammar aspectAG + ] + | kennedyWarren flags' + = vlist [debug4b, + if dumpgrammar flags' + then vlist [ pp "{- Dump of grammar with default rules" + , GrammarDump.pp_Syn_Grammar dump2 + , pp "-}" + ] + else empty] + | otherwise + = vlist [ vlist ( if not (ocaml flags') + then [ pp optionsLine + , pp pragmaBlocksTxt + , pp $ take 70 ("-- UUAGC " ++ drop 50 banner ++ " (" ++ input) ++ ")" + , pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 + then moduleHeader flags' mainName + else mkModuleHeader (Pass1.moduleDecl_Syn_AG output1) mainName "" "" False + ] + else [] + ) + , pp importBlocksTxt + , textBlocksDoc + , vlist $ if not (ocaml flags') + then Pass5.output_Syn_Program output5 + else Pass5a.output_Syn_Program output5a + , if dumpgrammar flags' + then vlist [ pp "{- Dump of grammar without default rules" + , GrammarDump.pp_Syn_Grammar dump1 + , pp "-}" + , pp "{- Dump of grammar with default rules" + , GrammarDump.pp_Syn_Grammar dump2 + , pp "-}" + ] + else empty + , if dumpcgrammar flags' + then vlist [ pp "{- Dump of cgrammar" + , CGrammarDump.pp_Syn_CGrammar dump3 + , pp "-}" + ] + else empty + ] + + let docTxt = disp doc 50000 "" + writeFile outputfile docTxt + -- HACK: write statistics + let nAuto = Pass3.nAutoRules_Syn_Grammar output3 + nExpl = Pass3.nExplicitRules_Syn_Grammar output3 + line = input ++ "," ++ show nAuto ++ "," ++ show nExpl ++ "\r\n" + case statsFile flags' of + Nothing -> return () + Just file -> appendFile file line + if not (null errorsToStopOn) then exitFailure else return () + + + +formatErrors :: PP_Doc -> String +formatErrors pp = disp pp 5000 "" + + +message2error :: Message Token Pos -> Error +message2error (Msg expect pos action) = ParserError pos (show expect) actionString + where actionString + = case action + of Insert s -> "inserting: " ++ show s + + Delete s -> "deleting: " ++ show s + + Other ms -> ms + +errorsToFront :: Options -> [Error] -> [Error] +errorsToFront flags mesgs = filter (PrErr.isError flags) mesgs ++ filter (not.(PrErr.isError flags)) mesgs + + +moduleHeader :: Options -> String -> String +moduleHeader flags input + = case moduleName flags + of Name nm -> genMod nm + Default -> genMod (defaultModuleName input) + NoName -> "" + where genMod x = "module " ++ x ++ " where" + +inputFile :: String -> String +inputFile name + = if ".ag" `isSuffixOf` name || ".lag" `isSuffixOf` name + then name + else name ++ ".ag" + +outputFile :: String -> String +outputFile name + = defaultModuleName name ++ ".hs" + +defaultModuleName :: String -> String +defaultModuleName name + = if ".ag" `isSuffixOf` name + then take (length name - 3) name + else if ".lag" `isSuffixOf` name + then take (length name - 4) name + else name + +stripPath :: String -> String +stripPath + = reverse . takeWhile (\c -> c /= '/' && c /= '\\') . reverse + +mkMainName :: String -> Maybe (String, String,String) -> String +mkMainName defaultName Nothing + = defaultName +mkMainName _ (Just (name, _, _)) + = name + +mkModuleHeader :: Maybe (String,String,String) -> String -> String -> String -> Bool -> String +mkModuleHeader Nothing defaultName _ _ _ + = "module " ++ defaultName ++ " where" +mkModuleHeader (Just (name, exports, imports)) _ suffix addExports replaceExports + = "module " ++ name ++ suffix ++ exp ++ " where\n" ++ imports ++ "\n" + where + exp = if null exports || (replaceExports && null addExports) + then "" + else if null addExports + then "(" ++ exports ++ ")" + else if replaceExports + then "(" ++ addExports ++ ")" + else "(" ++ exports ++ "," ++ addExports ++ ")" + +reportDeps :: Options -> [String] -> IO () +reportDeps flags files + = do results <- mapM (depsAG flags (searchPath flags)) files + let (fs, mesgs) = foldr combine ([],[]) results + let errs = take (min 1 (wmaxerrs flags)) (map message2error mesgs) + let ppErrs = PrErr.wrap_Errors (PrErr.sem_Errors errs) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags, PrErr.dups_Inh_Errors = []} + if null errs + then mapM_ putStrLn fs + else do putStr . formatErrors $ PrErr.pp_Syn_Errors ppErrs + exitFailure + where + combine :: ([a],[b]) -> ([a], [b]) -> ([a], [b]) + combine (fs, mesgs) (fsr, mesgsr) + = (fs ++ fsr, mesgs ++ mesgsr) + + +writeAttributeList :: String -> AttrMap -> IO () +writeAttributeList file mp + = writeFile file s + where + s = show $ map (\(x,y) -> (show x, y)) $ Map.toList $ Map.map (map (\(x,y) -> (show x, y)) . Map.toList . Map.map (map (\(x,y) -> (show x, show y)) . Set.toList)) $ mp + +readIrrefutableMap :: Options -> IO AttrMap +readIrrefutableMap flags + = case forceIrrefutables flags of + Just file -> do s <- readFile file + seq (length s) (return ()) + let lists :: [(String,[(String,[(String, String)])])] + lists = read s + return $ Map.fromList [ (identifier n, Map.fromList [(identifier c, Set.fromList [ (identifier fld, identifier attr) | (fld,attr) <- ss ]) | (c,ss) <- cs ]) | (n,cs) <- lists ] + Nothing -> return Map.empty + diff --git a/src/CommonTypes.hs b/src/CommonTypes.hs new file mode 100644 --- /dev/null +++ b/src/CommonTypes.hs @@ -0,0 +1,172 @@ +module CommonTypes where + +import Pretty +import UU.Scanner.Position(Pos,noPos) +import qualified Data.Map as Map +import Data.Map(Map) +import Data.Set(Set) +import qualified Data.Set as Set + + +type Blocks = Map BlockInfo [([String], Pos)] +type BlockInfo = (BlockType, Maybe NontermIdent) +data BlockType + = BlockImport + | BlockPragma + | BlockOther + deriving (Eq, Ord, Show) + +data Identifier = Ident { getName::String, getPos::Pos } + +instance Eq Identifier where + Ident x _ == Ident y _ = x == y + +instance Ord Identifier where + compare (Ident x _) (Ident y _) = compare x y + +instance Show Identifier where + show ident = getName ident + +instance PP Identifier where + pp = text . getName + +data Type = Haskell String + | NT Identifier [String] + +data ComplexType = List Type + | Tuple [(Identifier, Type)] + | Maybe Type + | Either Type Type + | Map Type Type + | IntMap Type + +instance Show ComplexType where + show (List t ) = "[" ++ show t ++ "]" + show (Tuple ts) = "(" ++ showList [ show n ++ ": " ++ show t | (n,t) <- ts ] "" ++ ")" + show (Maybe t ) = "Maybe " ++ show t + show (Either t1 t2) = "Either " ++ show t1 ++ " " ++ show t2 + show (Map t1 t2) = "Map " ++ show t1 ++ " " ++ show t2 + show (IntMap t1) = "IntMap " ++ show t1 + +instance Show Type where + show = typeToHaskellString Nothing [] + +type Attributes = Map Identifier Type +type TypeSyns = [(NontermIdent,ComplexType)] +type ParamMap = Map NontermIdent [Identifier] +type AttrNames = [(Identifier,Type,(String,String,String))] +type UseMap = Map NontermIdent (Map Identifier (String,String,String)) +type PragmaMap = Map NontermIdent (Map ConstructorIdent (Set Identifier)) +type AttrMap = Map NontermIdent (Map ConstructorIdent (Set (Identifier,Identifier))) +type UniqueMap = Map NontermIdent (Map ConstructorIdent (Map Identifier Identifier)) +type Fields = [(Identifier,Type)] +type Derivings = Map NontermIdent (Set Identifier) +type ClassContext = [(Identifier, [String])] +type ContextMap = Map NontermIdent ClassContext +type QuantMap = Map NontermIdent [String] +type Strings = [String] +type NontermIdent = Identifier +type ConstructorIdent = Identifier +type AttrOrderMap = Map NontermIdent (Map ConstructorIdent (Set Dependency)) +type VisitIdentifier = Int +type StateIdentifier = Int +data Dependency = Dependency Occurrence Occurrence deriving (Eq,Ord,Show) +data Occurrence + = OccAttr Identifier Identifier + | OccRule Identifier + deriving (Eq,Ord,Show) + +type AttrEnv = ( [Identifier] + , [(Identifier,Identifier)] + ) + +identifier x = Ident x noPos +nullIdent = identifier "" +_LHS = identifier "lhs" +_SELF = identifier "SELF" +_LOC = identifier "loc" +_INST = identifier "inst" +_INST' = identifier "inst'" +_FIELD = identifier "field" +_FIRST = identifier "first__" +_LAST = identifier "last__" + +sdtype :: NontermIdent -> String +sdtype nt = "T_"++getName nt + +cataname :: String -> Identifier -> String +cataname pre name = pre++getName name + +conname :: Bool -> NontermIdent -> ConstructorIdent -> String +conname rename nt con | rename = getName nt ++ "_" ++ getName con + | otherwise = getName con + +semname :: String -> NontermIdent -> ConstructorIdent -> String +semname pre nt con = pre ++ (getName nt ++ "_" ++ getName con) + +lhsname :: Bool -> Identifier -> String +lhsname isIn = attrname isIn _LHS + +attrname :: Bool -> Identifier -> Identifier -> String +attrname isIn field attr | field == _LOC = locname attr + | field == _INST = instname attr + | field == _INST' = inst'name attr + | field == _FIELD = fieldname attr + | otherwise = let direction | isIn = "I" + | otherwise = "O" + in '_' : getName field ++ direction ++ getName attr + +locname v = '_' : getName v +instname v = getName v ++ "_val_" +inst'name v = getName v ++ "_inst_" +fieldname v = getName v++"_" + +typeToAGString :: Type -> String +typeToAGString tp + = case tp of + Haskell t -> t + NT nt tps -> formatNonterminalToHaskell (getName nt) (map (\s -> "{" ++ s ++ "}") tps) + +typeToHaskellString :: Maybe NontermIdent -> [String] -> Type -> String +typeToHaskellString mbNt params tp + = case tp of + Haskell t -> t + NT nt tps | nt == _SELF -> formatNonterminalToHaskell (maybe "Unknown" getName mbNt) params + | otherwise -> formatNonterminalToHaskell (getName nt) tps + +formatNonterminalToHaskell :: String -> [String] -> String +formatNonterminalToHaskell nt tps + = unwords (nt:tps) + +ind :: String -> String +ind s = replicate 3 ' ' ++ s + +_NOCASE :: Identifier +_NOCASE = identifier "nocase" + +hasPragma :: PragmaMap -> NontermIdent -> ConstructorIdent -> Identifier -> Bool +hasPragma mp nt con nm + = nm `Set.member` Map.findWithDefault Set.empty con (Map.findWithDefault Map.empty nt mp) + +isNonterminal :: Type -> Bool +isNonterminal (NT _ _) = True +isNonterminal _ = False + +isSELFNonterminal :: Type -> Bool +isSELFNonterminal (NT nt _) | nt == _SELF = True +isSELFNonterminal _ = False + +-- TODO: check if the name needs to be converted if the name is T_ +extractNonterminal :: Type -> NontermIdent +extractNonterminal (NT n _) = maybe n id (deforestedNt n) + +nontermArgs :: Type -> [String] +nontermArgs tp + = case tp of + NT _ args -> args + _ -> [] + +deforestedNt :: Identifier -> Maybe Identifier +deforestedNt nm + | take 2 (getName nm) == "T_" = Just (Ident (drop 2 (getName nm)) (getPos nm)) + | otherwise = Nothing diff --git a/src/DepTypes.hs b/src/DepTypes.hs new file mode 100644 --- /dev/null +++ b/src/DepTypes.hs @@ -0,0 +1,141 @@ +module DepTypes where + +import CommonTypes + +------------------------------------------------------------------------------- +-- Class definitions +------------------------------------------------------------------------------- + +class HasAttrAndField a where + getField :: a -> Identifier + getAttr :: a -> Identifier + +class ContainsTrace a where + addTraceElem :: TraceElem -> a -> a + addTrace :: Trace -> a -> a + +------------------------------------------------------------------------------- +-- Vertices +------------------------------------------------------------------------------- + +-- kan helaas niet met named fields, want dat levert een conflict op in de uniekheid vd naamgeving. +-- ERROR "CommonTypes.hs" (line 44): Repeated definition for selector "nt" + +data Vertex = Local Identifier Identifier Identifier -- lhs nt, constructor, attribute + | LHSInh Identifier Identifier Identifier -- lhs nt, constructor, attribute + | LHSSyn Identifier Identifier Identifier -- lhs nt, constructor, attribute + | ShRHSInh Identifier Identifier Identifier Identifier -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSInh!! + | ShRHSSyn Identifier Identifier Identifier Identifier -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSSyn!! + | RHSInh Identifier Identifier Identifier Identifier Identifier -- rhs nt, lhs nt, constructor, field, attribute + | RHSSyn Identifier Identifier Identifier Identifier Identifier -- rhs nt, lhs nt, constructor, field, attribute + | NTInh Identifier Identifier -- nt, attribute + | NTSyn Identifier Identifier -- nt, attribute + +instance Eq Vertex where + Local lhs1 con1 attr1 == Local lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 + LHSInh lhs1 con1 attr1 == LHSInh lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 + LHSSyn lhs1 con1 attr1 == LHSSyn lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 + ShRHSInh lhs1 con1 name1 attr1 == ShRHSInh lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 + ShRHSSyn lhs1 con1 name1 attr1 == ShRHSSyn lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 + RHSInh rhs1 lhs1 con1 name1 attr1 == RHSInh rhs2 lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 + RHSSyn rhs1 lhs1 con1 name1 attr1 == RHSSyn rhs2 lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 + ShRHSInh lhs1 con1 name1 attr1 == RHSInh _ lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 + ShRHSSyn lhs1 con1 name1 attr1 == RHSSyn _ lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 + RHSInh _ lhs1 con1 name1 attr1 == ShRHSInh lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 + RHSSyn _ lhs1 con1 name1 attr1 == ShRHSSyn lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 + NTInh nt1 attr1 == NTInh nt2 attr2 = nt1==nt2 && attr1==attr2 + NTSyn nt1 attr1 == NTSyn nt2 attr2 = nt1==nt2 && attr1==attr2 + _ == _ = False + +instance HasAttrAndField Vertex where + getAttr (Local _ _ attr) = attr + getAttr (LHSInh _ _ attr) = attr + getAttr (LHSSyn _ _ attr) = attr + getAttr (ShRHSInh _ _ _ attr) = attr + getAttr (ShRHSSyn _ _ _ attr) = attr + getAttr (RHSInh _ _ _ _ attr) = attr + getAttr (RHSSyn _ _ _ _ attr) = attr + getAttr (NTInh _ attr) = attr + getAttr (NTSyn _ attr) = attr + getField (Local _ _ _) = nullIdent + getField (LHSInh _ _ _) = _LHS + getField (LHSSyn _ _ _) = _LHS + getField (ShRHSInh _ _ fld _) = fld + getField (ShRHSSyn _ _ fld _) = fld + getField (RHSInh _ _ _ fld _) = fld + getField (RHSSyn _ _ _ fld _) = fld + getField (NTInh _ _) = nullIdent + getField (NTSyn _ _) = nullIdent + +instance Show Vertex where + show (Local lhs con attr) = show lhs ++ "." ++ show attr ++ "(L," ++ show lhs ++ "." ++ show con ++ ")" + show (LHSInh lhs con attr) = show lhs ++ "." ++ show attr ++ "(I," ++ show lhs ++ "." ++ show con ++ ".lhs)" + show (LHSSyn lhs con attr) = show lhs ++ "." ++ show attr ++ "(S," ++ show lhs ++ "." ++ show con ++ ".lhs)" + show (ShRHSInh lhs con name attr) = "" + show (ShRHSSyn lhs con name attr) = "" + show (RHSInh rhs lhs con name attr) = show rhs ++ "." ++ show attr ++ "(I," ++ show lhs ++ "." ++ show con ++ "." ++ show name ++ ")" + show (RHSSyn rhs lhs con name attr) = show rhs ++ "." ++ show attr ++ "(S," ++ show lhs ++ "." ++ show con ++ "." ++ show name ++ ")" + show (NTInh nt attr) = "" + show (NTSyn nt attr) = "" + + +------------------------------------------------------------------------------- +-- Streams, results +------------------------------------------------------------------------------- + +type UseStream = (Vertex,Stream) +type Stream = [Result] +type Result = ([UsedAttr],[UsedAttr]) +data UsedAttr = Loc Identifier Identifier Trace -- field name and attribute name + | Glo Identifier Trace -- attribute name + +-- lhs en rhs slaan op de lhs en rhs van een attribute equation en niet van de productie!! +data TraceElem = TE { lineNr :: Int + , nt :: NontermIdent + , prod :: Identifier + , lhsNt :: NontermIdent + , lhsFld :: Identifier + , lhsAttr :: Identifier + , rhsFld :: Identifier + , rhsAttr :: Identifier } deriving Show + +type Trace = [TraceElem] + +getTrace :: UsedAttr -> Trace +getTrace (Loc _ _ trace) = trace +getTrace (Glo _ trace) = trace + +toPair :: UsedAttr -> (Identifier,Trace) +toPair (Loc _ attr trace) = (attr,trace) +toPair (Glo attr trace) = (attr,trace) + +-- de Eq op Res negeert de trace, want dit is geen onderdeel van het resultaat, maar een oorzaak ervan. +-- hierdoor kan gewoon de elem functie op sets van resultaten gebruikt worden. +instance Eq UsedAttr where + Loc fld1 attr1 _ == Loc fld2 attr2 _ = fld1==fld2 && attr1==attr2 + Glo attr1 _ == Glo attr2 _ = attr1==attr2 + _ == _ = False + +instance Show UsedAttr where + show (Loc fld attr trace) = "(" ++ show fld ++ "," ++ show attr ++ ")" + show (Glo attr trace) = show attr + +instance HasAttrAndField UsedAttr where + getAttr (Loc _ attr _) = attr + getAttr (Glo attr _) = attr + getField (Loc fld attr _) = fld + getField _ = nullIdent + +instance ContainsTrace UsedAttr where + addTraceElem newtre (Loc fld attr oldtr) = Loc fld attr (newtre:oldtr) + addTraceElem newtre (Glo attr oldtr) = Glo attr (newtre:oldtr) + addTrace newtr (Loc fld attr oldtr) = Loc fld attr (newtr++oldtr) + addTrace newtr (Glo attr oldtr) = Glo attr (newtr++oldtr) + +instance ContainsTrace Result where + addTraceElem newcs (set,upd) = (map (addTraceElem newcs) set,map (addTraceElem newcs) upd) + addTrace newcss (set,upd) = (map (addTrace newcss) set,map (addTrace newcss) upd) + +instance ContainsTrace Stream where + addTraceElem newcs stream = map (addTraceElem newcs) stream + addTrace newcss stream = map (addTrace newcss) stream diff --git a/src/GrammarInfo.hs b/src/GrammarInfo.hs new file mode 100644 --- /dev/null +++ b/src/GrammarInfo.hs @@ -0,0 +1,52 @@ +module GrammarInfo where + +import SequentialTypes +import CodeSyntax +import Data.Map(Map) +import qualified Data.Map as Map +import Data.Set(Set) +import qualified Data.Set as Set +import CommonTypes +import Data.List(intersect,(\\)) + +type LMH = (Vertex,Vertex,Vertex) +data Info = Info { tdpToTds :: Table Vertex + , tdsToTdp :: Table [Vertex] + , attrTable :: Table NTAttr + , ruleTable :: Table CRule + , lmh :: [LMH] + , nonts :: [(NontermIdent,[ConstructorIdent])] + , wraps :: Set NontermIdent + } + deriving Show + +instance Show CRule + where show (CRule name isIn hasCode nt con field childnt tp pattern rhs defines owrt origin uses _ _) + = "CRule " ++ show name ++ " nt: " ++ show nt ++ " con: " ++ show con ++ " field: " ++ show field + ++ " childnt: " ++ show childnt ++ " rhs: " ++ concat rhs ++ " uses: " ++ show [ attrname True fld nm | (fld,nm) <- Set.toList uses ] + +type CInterfaceMap = Map NontermIdent CInterface +type CVisitsMap = Map NontermIdent (Map ConstructorIdent CVisits) + +data CycleStatus + = CycleFree CInterfaceMap CVisitsMap + | LocalCycle [Route] + | InstCycle [Route] + | DirectCycle [EdgeRoutes] + | InducedCycle CInterfaceMap [EdgeRoutes] + +showsSegment :: CSegment -> [String] +showsSegment (CSegment inh syn) + = let syn' = map toString (Map.toList syn) + inh' = map toString (Map.toList inh) + toString (a,t) = (getName a, case t of (NT nt tps) -> getName nt ++ " " ++ unwords tps; Haskell t -> t) + chnn = inh' `intersect` syn' + inhn = inh' \\ chnn + synn = syn' \\ chnn + disp name [] = [] + disp name as = (name ++ if length as == 1 then " attribute:" else " attributes:") : + map (\(x,y) -> ind x ++ replicate ((20 - length x) `max` 0) ' ' ++ " : " ++ y) as + in disp "inherited" inhn + ++ disp "chained" chnn + ++ disp "synthesized" synn + diff --git a/src/HsTokenScanner.hs b/src/HsTokenScanner.hs new file mode 100644 --- /dev/null +++ b/src/HsTokenScanner.hs @@ -0,0 +1,160 @@ + +module HsTokenScanner where +import HsToken +import UU.Scanner.Position +import List(sort) +import UU.Util.BinaryTrees +import CommonTypes +import Maybe +import Char +isAGesc c = c == '@' + +lexTokens :: Pos -> String -> [HsToken] +lexTokens = scanTokens keywordstxt keywordsops specialchars opchars + where keywordstxt = [] + keywordsops = [".","=", ":=", ":","|","@"] + specialchars = ";()[],_{}`" + opchars = "!#$%&*+./<=>?@\\^|-~:" + + +scanTokens :: [String] -> [String] -> String -> String -> Pos -> String -> [HsToken] +scanTokens keywordstxt keywordsops specchars opchars pos input + = doScan pos input + + where + locatein :: Ord a => [a] -> a -> Bool + locatein es = isJust . btLocateIn compare (tab2tree (sort es)) + iskw = locatein keywordstxt + isop = locatein keywordsops + isSymbol = locatein specchars + isOpsym = locatein opchars + + isIdStart c = isLower c || c == '_' + + isIdChar c = isAlphaNum c + || c == '\'' + || c == '_' + + scanIdent p s = let (name,rest) = span isIdChar s + in (name,advc (length name) p,rest) + + doScan p [] = [] + doScan p (c:s) | isSpace c = let (sp,next) = span isSpace s + in doScan (foldl (flip updPos) p (c:sp)) next + doScan p (c:d:s) | isAGesc c && isIdStart d = + let (fld,p2,rest) = scanIdent (advc 2 p) s + field = d:fld + in case rest of + ('.':r:rs) + | isIdStart r -> let (at,p3,rest2) = scanIdent (advc 2 p2) rs + attr = r : at + in AGField (Ident field p) (Ident attr p) p Nothing : doScan p3 rest2 + _ -> AGLocal (Ident field p) p Nothing : doScan p2 rest + + doScan p ('-':'-':s) = doScan p (dropWhile (/= '\n') s) + doScan p ('{':'-':s) = advc' 2 p (lexNest doScan) s -- } + doScan p ('"':ss) + = let (s,swidth,rest) = scanString ss + in if null rest || head rest /= '"' + then Err "Unterminated string literal" p : advc' swidth p doScan rest + else StrToken s p : advc' (swidth+2) p doScan (tail rest) + + doScan p ('\'':ss) + = let (mc,cwidth,rest) = scanChar ss + in case mc of + Nothing -> Err "Error in character literal" p : advc' cwidth p doScan rest + Just c -> if null rest || head rest /= '\'' + then Err "Unterminated character literal" p : advc' (cwidth+1) p doScan rest + else CharToken [c] p : advc' (cwidth+2) p doScan (tail rest) + doScan p cs@(c:s) + + | isIdStart c || isUpper c + = let (name', p', s') = scanIdent (advc 1 p) s + name = c:name' + tok = if iskw name + then HsToken name p -- keyword + else if null name' && isSymbol c + then HsToken [c] p -- '_' + else HsToken name p -- varid / conid + in tok : doScan p' s' + | isOpsym c = let (name, s') = span isOpsym cs + tok | isop name = HsToken name p + | otherwise = HsToken name p + in tok : doScan (foldl (flip updPos) p name) s' + | isDigit c = let (base,digs,width,s') = getNumber cs + number = case base of + 8 -> "0o"++digs + 10 -> digs + 16 -> "0x"++digs + in HsToken number p : advc' width p doScan s' + | isSymbol c = HsToken [c] p : advc' 1 p doScan s + | otherwise = Err ("Unexpected character " ++ show c) p : updPos' c p doScan s + + +lexNest cont pos inp = lexNest' cont pos inp + where lexNest' c p ('{':'-':s) = lexNest' (lexNest' c) (advc 2 p) s + lexNest' c p ('-':'}':s) = c (advc 2 p) s + lexNest' c p (x:s) = lexNest' c (updPos x p) s + lexNest' _ _ [] = [Err "Unterminated nested comment" pos] + + +scanString [] = ("",0,[]) +scanString ('\\':'&':xs) = let (str,w,r) = scanString xs + in (str,w+2,r) +scanString ('\'':xs) = let (str,w,r) = scanString xs + in ('\'': str,w+1,r) +scanString xs = let (ch,cw,cr) = getchar xs + (str,w,r) = scanString cr + str' = maybe "" (:str) ch + in maybe ("",0,xs) (\c -> (c:str,cw+w,r)) ch + +scanChar ('"' :xs) = (Just '"',1,xs) +scanChar xs = getchar xs + +getchar [] = (Nothing,0,[]) +getchar s@('\n':_ ) = (Nothing,0,s ) +getchar s@('\t':_ ) = (Nothing,0,s) +getchar s@('\'':_ ) = (Nothing,0,s) +getchar s@('"' :_ ) = (Nothing,0,s) +getchar ('\\':xs) = let (c,l,r) = getEscChar xs + in (c,l+1,r) +getchar (x:xs) = (Just x,1,xs) + +getEscChar [] = (Nothing,0,[]) +getEscChar s@(x:xs) | isDigit x = let (base,n,len,rest) = getNumber s + val = readn base n + in if val >= 0 && val <= 255 + then (Just (chr val),len, rest) + else (Nothing,1,rest) + | otherwise = case x `lookup` cntrChars of + Nothing -> (Nothing,0,s) + Just c -> (Just c,1,xs) + where cntrChars = [('a','\a'),('b','\b'),('f','\f'),('n','\n'),('r','\r'),('t','\t') + ,('v','\v'),('\\','\\'),('"','\"'),('\'','\'')] + +readn base n = foldl (\r x -> value x + base * r) 0 n + +getNumber cs@(c:s) + | c /= '0' = num10 + | null s = const0 + | hs == 'x' || hs == 'X' = num16 + | hs == 'o' || hs == 'O' = num8 + | otherwise = num10 + where (hs:ts) = s + const0 = (10, "0",1,s) + num10 = let (n,r) = span isDigit cs + in (10,n,length n,r) + num16 = readNum isHexaDigit ts 16 + num8 = readNum isOctalDigit ts 8 + readNum p ts tk + = let nrs@(n,rs) = span p ts + in if null n then const0 + else (tk , n, 2+length n,rs) + +isHexaDigit d = isDigit d || (d >= 'A' && d <= 'F') || (d >= 'a' && d <= 'f') +isOctalDigit d = d >= '0' && d <= '7' + +value c | isDigit c = ord c - ord '0' + | isUpper c = ord c - ord 'A' + 10 + | isLower c = ord c - ord 'a' + 10 + diff --git a/src/KennedyWarren.hs b/src/KennedyWarren.hs new file mode 100644 --- /dev/null +++ b/src/KennedyWarren.hs @@ -0,0 +1,657 @@ +module KennedyWarren where + +import CommonTypes +import Pretty +import Knuth1 +import ExecutionPlan +import Debug.Trace +import Control.Monad.ST +import Control.Monad.State +import Control.Monad.Error +import Data.STRef +import Data.Maybe +import Data.List +import Data.Ord + +import qualified Data.Set as Set +import qualified Data.Map as Map +import qualified Data.IntMap as IntMap +import qualified Data.IntSet as IntSet + +kennedyWarrenOrder :: Set.Set NontermIdent -> [NontDependencyInformation] -> TypeSyns -> Maybe ExecutionPlan +kennedyWarrenOrder wr ndis typesyns = runST $ do + indi <- mapM mkNontDependencyInformationM ndis + knuth1 indi + -- Check all graphs for cyclicity, transitive closure and consistency + traceST $ "Checking graphs..." + allok <- forM indi $ \ndi -> do + let nont = ndiNonterminal . ndimOrig $ ndi + let g = ndgmDepGraph . ndimDepGraph $ ndi + -- Topological sort + --tsedg <- graphTopSort g + -- Cyclicity check + c1 <- graphIsCyclic g + when c1 $ traceST $ "Nonterminal graph " ++ show nont ++ " is cylic!" + -- Transtive closure check + --trc <- graphIsTRC g + --when (not trc) $ traceST $ "Nonterminal graph " ++ show nont ++ " is not transitively closed!" + -- Consistency check + cons <- graphCheckConsistency g + when (not cons) $ traceST $ "Nonterminal graph " ++ show nont ++ " is not consistent!" + -- Loop trough all productions + allok <- forM (ndimProds ndi) $ \prod -> do + let pr = pdgProduction $ pdgmOrig prod + let g = pdgmDepGraph $ prod + -- Topsort + --addTopSortEdges tsedg prod + -- Check for cyclicity + c2 <- graphIsCyclic g + when c2 $ traceST $ "Production graph " ++ show pr ++ " of nonterminal " + ++ show nont ++ " is cylic!" + -- Transtive closure check + trc <- graphIsTRC g + when (not trc) $ traceST $ "Production graph " ++ show pr ++ " of nonterminal " + ++ show nont ++ " is not transitively closed!" + -- Check consistency + cons <- graphCheckConsistency g + when (not cons) $ traceST $ "Production graph " ++ show pr ++ " of nonterminal " + ++ show nont ++ " is not consistent!" + return $ (not c2) && trc && cons + return $ (and allok) && (not c1) && cons + if (and allok) + then do + -- Create non-transitive closed graph for efficiency + indi <- undoTransitiveClosure indi + -- Doing kennedywarren + ret <- runVG $ do + traceVG $ "Running kennedy-warren..." + initvs <- kennedyWarrenVisitM wr indi + -- Generate execution plan + kennedyWarrenExecutionPlan indi initvs wr typesyns + -- Return the result + return $ Just ret + else return Nothing + +------------------------------------------------------------------------------- +-- Debugging functionality +------------------------------------------------------------------------------- + +-- | Pretty print a vertex in GraphViz format +toGVVertex :: Bool -> Vertex -> ST s PP_Doc +toGVVertex l (VAttr t a b) = return $ (text $ "attr_" ++ show t ++ "_" ++ show a ++ "_" ++ show b) >#< if l + then text ("[shape=box,label=\"" ++ show t ++ " @" ++ show a ++ "." ++ show b ++ "\"]") else empty +toGVVertex l (VChild c) = return $ (text $ "child_" ++ show c) >#< if l + then text ("[shape=ellipse,label=\"Child " ++ show c ++ "\"]") else empty +toGVVertex l (VRule r) = return $ (text $ "rule_" ++ show r) >#< if l + then text ("[shape=diamond,label=\"" ++ show r ++ "\"]") else empty + +-- | Pretty print an edge in GraphViz format +toGVEdge :: Edge -> ST s PP_Doc +toGVEdge (v1, v2) = do r1 <- toGVVertex False v1 + r2 <- toGVVertex False v2 + return $ r1 >|< text "->" >#< r2 + +-- | Pretty print a NontDependencyInformation in GraphViz format +toGVNontDependencyInfo :: NontDependencyInformationM s -> ST s PP_Doc +toGVNontDependencyInfo ndi = do dg <- return $ ndgmDepGraph . ndimDepGraph $ ndi + verts <- graphVertices dg + edges <- graphEdges dg + vtexts <- mapM (toGVVertex True) verts + etexts <- mapM toGVEdge edges + ptexts <- mapM toGVProdDependencyGraph (ndimProds ndi) + return $ (text ("digraph ndg_" ++ show (ndiNonterminal $ ndimOrig ndi) ++ " {") + >-< + vlist vtexts + >-< + vlist etexts + >-< + text "}" + >-< + text "" -- empty line + >-< + vlist ptexts) + +-- | Pretty print a ProdDependencyGraph in GraphViz format +toGVProdDependencyGraph :: ProdDependencyGraphM s -> ST s PP_Doc +toGVProdDependencyGraph pdg = do dg <- return $ pdgmDepGraph pdg + verts <- graphVertices dg + edges <- graphEdges dg + vtexts <- mapM (toGVVertex True) verts + etexts <- mapM toGVEdge edges + return $ (text ("digraph pdg_" ++ show (pdgProduction $ pdgmOrig pdg) ++ " {") + >-< + (vlist vtexts) + >-< + (vlist etexts) + >-< + text ("info [shape=box,label=\"" ++ show (pdgChildMap $ pdgmOrig pdg) ++ "\"];") + >-< + text "}" + >-< + text "") + +------------------------------------------------------------------------------- +-- Kennedy-Warren in monadic style +------------------------------------------------------------------------------- +{- +runVG :: VG s a -> ST s a +insertInitialNode :: NontDependencyInformationM s -> VG s VGNode +createPending :: VGNode -> Set.Set Identifier -> Set.Set Identifier -> VG s VGEdge +selectPending :: VG s VGEdge +getInherited :: VGEdge -> VG s (Set.Set Identifier) +getSynthesized :: VGEdge -> VG s (Set.Set Identifier) +markFinal :: VGEdge -> VG s () +getProductions :: VGEdge -> VG s [VGProd] +onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a +isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool +setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () +getChildState :: VGProd -> Identifier -> VG s VGNode +addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep +addVisitStep :: VGProd -> VisitStep -> VG s () +repeatM :: VG s () -> VG s () +-} + +newtype VGNode = VGNode Int deriving (Show,Eq,Ord) +newtype VGEdge = VGEdge Int deriving (Show,Eq,Ord) +newtype VGProd = VGProd (VGEdge,Int) deriving (Show,Eq,Ord) + +data VGState s = VGState { vgNodeNum :: Int + , vgEdgeNum :: Int + -- Node maps + , vgOutgoing :: IntMap.IntMap (STRef s (Set.Set VGEdge)) + , vgIncoming :: IntMap.IntMap (Maybe VGEdge) + , vgNDI :: IntMap.IntMap (STRef s (NontDependencyInformationM s)) + , vgInhSynNode :: Map.Map (Identifier, Set.Set Identifier, Set.Set Identifier) VGNode + , vgNodeInhSyn :: IntMap.IntMap (Set.Set Identifier, Set.Set Identifier) + , vgInitial :: Map.Map Identifier VGNode + -- Edge maps + , vgEdges :: IntMap.IntMap (VGNode, VGNode) + , vgEdgesR :: Map.Map (VGNode,VGNode) VGEdge + , vgInherited :: IntMap.IntMap (Set.Set Identifier) + , vgSynthesized :: IntMap.IntMap (Set.Set Identifier) + , vgPending :: IntSet.IntSet + , vgChildVisits :: IntMap.IntMap (STRef s (Map.Map (Identifier,Int) [VGNode])) + -- Final vertices in production graphs + , vgFinalVertices :: IntMap.IntMap (STRef s (Set.Set (Vertex,Int))) + -- Construction of execution plan (Nonterminal,Production,Visit) + , vgProdVisits :: Map.Map (Identifier,Identifier,VGEdge) (STRef s [VisitStep]) + } + +type VG s a = ErrorT String (StateT (VGState s) (ST s)) a + +------------------------------------------------------------ +--- Public functions --- +------------------------------------------------------------ +-- | Run the VG monad in the ST monad +runVG :: VG s a -> ST s a +runVG vg = do (Right a,rs) <- runStateT (runErrorT vg) vgEmptyState + return a + +-- | Insert an initial node for this nonterminal into the visit graph +insertInitialNode :: NontDependencyInformationM s -> VG s VGNode +insertInitialNode ndi = do + rndi <- vgInST $ newSTRef ndi + (VGNode node) <- vgCreateNode rndi Set.empty Set.empty + initial <- gets vgInitial + incoming <- gets vgIncoming + modify $ \st -> st { vgInitial = Map.insert (ndiNonterminal $ ndimOrig ndi) (VGNode node) initial + , vgIncoming = IntMap.insert node Nothing incoming } + return (VGNode node) + +-- | Create a pending edge from this node with a set of inherited and synthesized attributes +createPending :: VGNode -> Set.Set Identifier -> Set.Set Identifier -> VG s VGEdge +createPending vgn@(VGNode n) inh syn = do + -- Check if target node already exists + ninhsyn <- gets vgNodeInhSyn + let (pinh,psyn) = imLookup n ninhsyn + let ninh = Set.union pinh inh + let nsyn = Set.union psyn syn + mndi <- gets vgNDI + let rndi = imLookup n mndi + ndi <- vgInST $ readSTRef rndi + inhsynn <- gets vgInhSynNode + case Map.lookup (ndiNonterminal $ ndimOrig ndi, ninh, nsyn) inhsynn of + Just tn -> do + when (tn == vgn) $ do traceVG $ "Source and target nodes are the same!" + traceVG $ "Maybe there is a wrapper with no inherited or synthesized attributes." + traceVG $ "Inh: " ++ show inh + traceVG $ "Syn: " ++ show syn + traceVG $ "PInh: " ++ show pinh + traceVG $ "PSyn: " ++ show psyn + -- tn is target node, now check if edge exists and create if not + edgesr <- gets vgEdgesR + case Map.lookup (vgn,tn) edgesr of + Just e -> return e + Nothing -> vgCreatePendingEdge vgn tn inh syn + Nothing -> do + -- target node does not exist, create it and then create the new edge + tn <- vgCreateNode rndi ninh nsyn + vgCreatePendingEdge vgn tn inh syn + +-- | Return an arbitrary pending edge of which the from node is ready +selectPending :: VG s VGEdge +selectPending = do + pending <- gets vgPending + incoming <- gets vgIncoming + edges <- gets vgEdges + let readyPend = filter (\p -> let (VGNode fr,_) = imLookup p edges + in isJust $ IntMap.lookup fr incoming) $ IntSet.toList pending + guard $ not $ null readyPend + return $ VGEdge $ head $ readyPend + +-- | Get the inherited attributes of an edge +getInherited :: VGEdge -> VG s (Set.Set Identifier) +getInherited (VGEdge edg) = do + inhs <- gets vgInherited + return $ imLookup edg inhs + +-- | Get the synthesized attributes of an edge +getSynthesized :: VGEdge -> VG s (Set.Set Identifier) +getSynthesized (VGEdge edg) = do + syns <- gets vgSynthesized + return $ imLookup edg syns + +-- | Mark an edge as final +markFinal :: VGEdge -> VG s () +markFinal vgedg@(VGEdge edg) = do + incoming <- gets vgIncoming + edges <- gets vgEdges + pending <- gets vgPending + let (VGNode from,VGNode to) = imLookup edg edges + modify $ \st -> st { vgIncoming = IntMap.insert to (Just vgedg) incoming + , vgPending = IntSet.delete edg pending } + +-- | Get all productions for an edge +getProductions :: VGEdge -> VG s [VGProd] +getProductions vedg@(VGEdge edg) = do + edges <- gets vgEdges + let (VGNode fr,_) = imLookup edg edges + ndis <- gets vgNDI + let rndi = imLookup fr ndis + ndi <- vgInST $ readSTRef rndi + return $ map (\x -> VGProd (vedg,x)) [0..(length $ ndimProds ndi)-1] + +-- | Execute a function on the dependency graph for this production +onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a +onMarkedDepGraph f (VGProd (VGEdge edg, n)) = do + edges <- gets vgEdges + let (VGNode fr,_) = imLookup edg edges + ndis <- gets vgNDI + let rndi = imLookup fr ndis + ndi <- vgInST $ readSTRef rndi + vgInST $ f $ (ndimProds ndi) !! n -- not efficient, but lists are usually short + +-- | Check whether this vertex has been marked as final +isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool +isDepGraphVertexFinal (VGProd (VGEdge edg, p)) v = do + edges <- gets vgEdges + let (from,_) = imLookup edg edges + vgDepGraphVertexFinal from p v + +-- | Mark these vertices final in this production +setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () +setDepGraphVerticesFinal (VGProd (VGEdge edg, p)) vs = do + edges <- gets vgEdges + let (_,VGNode to) = imLookup edg edges + finalv <- gets vgFinalVertices + let rfinalv = imLookup to finalv + vgInST $ modifySTRef rfinalv $ Set.union (Set.fromList $ map (\v -> (v,p)) vs) + +-- | Add a child visit to this production and return the step for the execution plan +addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep +addChildVisit vgp@(VGProd (VGEdge edg, p)) id (VGEdge vs) = do + edges <- gets vgEdges + let (VGNode from,vgto@(VGNode to)) = imLookup vs edges -- from must be equal to the current state + childvs <- gets vgChildVisits + let rchildv = imLookup edg childvs + vgInST $ modifySTRef rchildv $ Map.insertWith' (++) (id,p) [vgto] + ndis <- gets vgNDI + let rndi = imLookup from ndis + ndi <- vgInST $ readSTRef rndi + let nt = ndiNonterminal $ ndimOrig ndi + return $ ChildVisit id nt vs + +-- | Add a step to the execution plan of this visit +addVisitStep :: VGProd -> VisitStep -> VG s () +addVisitStep (VGProd (VGEdge edg, p)) st = do + edges <- gets vgEdges + let (VGNode fr,_) = imLookup edg edges + ndis <- gets vgNDI + let rndi = imLookup fr ndis + ndi <- vgInST $ readSTRef rndi + prodvs <- gets vgProdVisits + let nont = ndiNonterminal $ ndimOrig ndi + let prod = pdgProduction $ pdgmOrig $ ndimProds ndi !! p + let Just rprodv = Map.lookup (nont, prod, VGEdge edg) prodvs + vgInST $ modifySTRef rprodv (++ [st]) + +-- | Get the state of a child in a certain production +getChildState :: VGProd -> Identifier -> VG s VGNode +getChildState (VGProd (VGEdge edg,p)) id = do + childvs <- gets vgChildVisits + let rchildv = imLookup edg childvs + childv <- vgInST $ readSTRef rchildv + case Map.lookup (id,p) childv of + Just (n:_) -> return n + Nothing -> do + -- Look for previous edge + edges <- gets vgEdges + let (VGNode from,_) = imLookup edg edges + incoming <- gets vgIncoming + case IntMap.lookup from incoming of + Just (Just iedg) -> getChildState (VGProd (iedg,p)) id + Just Nothing -> do + -- Lookup initial state + ndis <- gets vgNDI + let rndi = imLookup from ndis + ndi <- vgInST $ readSTRef rndi + let Just nt = lookup id $ pdgChildMap $ pdgmOrig $ (ndimProds ndi) !! p + vgFindInitial nt + Nothing -> error "getChildState" + +-- | Repeat action untill mzero is encountered +repeatM :: VG s () -> VG s () +repeatM m = catchError (m >> repeatM m) (const $ return ()) + +------------------------------------------------------------ +--- Internal functions --- +------------------------------------------------------------ +-- | Execute a ST action inside the VG monad +vgInST :: ST s a -> VG s a +vgInST = lift . lift + +vgEmptyState :: VGState s +vgEmptyState = VGState { vgNodeNum = 0 + , vgEdgeNum = 0 + , vgOutgoing = IntMap.empty + , vgIncoming = IntMap.empty + , vgNDI = IntMap.empty + , vgInhSynNode = Map.empty + , vgNodeInhSyn = IntMap.empty + , vgInitial = Map.empty + , vgEdges = IntMap.empty + , vgEdgesR = Map.empty + , vgInherited = IntMap.empty + , vgSynthesized = IntMap.empty + , vgPending = IntSet.empty + , vgChildVisits = IntMap.empty + , vgFinalVertices = IntMap.empty + , vgProdVisits = Map.empty + } +-- | Create a new node +vgCreateNode :: STRef s (NontDependencyInformationM s) -> Set.Set Identifier -> Set.Set Identifier -> VG s VGNode +vgCreateNode rndi inh syn = do + num <- gets vgNodeNum + outgoing <- gets vgOutgoing + inhsyn <- gets vgInhSynNode + ninhsyn <- gets vgNodeInhSyn + ndi <- gets vgNDI + finalv <- gets vgFinalVertices + rout <- vgInST $ newSTRef Set.empty + rfinalv <- vgInST $ newSTRef Set.empty + nndi <- vgInST $ readSTRef rndi + modify $ \st -> st { vgNodeNum = num + 1 + , vgOutgoing = IntMap.insert num rout outgoing + , vgInhSynNode = Map.insert (ndiNonterminal $ ndimOrig nndi,inh,syn) (VGNode num) inhsyn + , vgNodeInhSyn = IntMap.insert num (inh,syn) ninhsyn + , vgNDI = IntMap.insert num rndi ndi + , vgFinalVertices = IntMap.insert num rfinalv finalv } + return $ VGNode num + +-- | Create a new pending edge +vgCreatePendingEdge :: VGNode -> VGNode -> Set.Set Identifier -> Set.Set Identifier -> VG s VGEdge +vgCreatePendingEdge vgn1@(VGNode n1) vgn2@(VGNode n2) inh syn = do + num <- gets vgEdgeNum + edges <- gets vgEdges + edgesr <- gets vgEdgesR + inhs <- gets vgInherited + syns <- gets vgSynthesized + outgoing <- gets vgOutgoing + pend <- gets vgPending + childv <- gets vgChildVisits + rchildv <- vgInST $ newSTRef Map.empty + let outr = imLookup n1 outgoing + let ret = VGEdge num + vgInST $ modifySTRef outr (Set.insert ret) + modify $ \st -> st { vgEdgeNum = num + 1 + , vgEdges = IntMap.insert num (vgn1,vgn2) edges + , vgEdgesR = Map.insert (vgn1,vgn2) ret edgesr + , vgPending = IntSet.insert num pend + , vgInherited = IntMap.insert num inh inhs + , vgSynthesized = IntMap.insert num syn syns + , vgChildVisits = IntMap.insert num rchildv childv } + -- Add prod visits (for constructing an execution plan) + ndis <- gets vgNDI + let rndi = imLookup n1 ndis + ndi <- vgInST $ readSTRef rndi + prodv <- gets vgProdVisits + refs <- forM (ndimProds ndi) $ \prod -> do + rprod <- vgInST $ newSTRef [] + return ((ndiNonterminal $ ndimOrig ndi, pdgProduction $ pdgmOrig prod, ret),rprod) + modify $ \st -> st { vgProdVisits = Map.union (Map.fromList refs) prodv } + return $ ret + +-- | Check whether a vertex is marked final on this node in this production +vgDepGraphVertexFinal :: VGNode -> Int -> Vertex -> VG s Bool +vgDepGraphVertexFinal (VGNode n) p v = do + finalv <- gets vgFinalVertices + let rfinalv = imLookup n finalv + curset <- vgInST $ readSTRef rfinalv + if Set.member (v,p) curset + then return True + else do + incoming <- gets vgIncoming + case IntMap.lookup n incoming of + Just (Just (VGEdge edg)) -> do + edges <- gets vgEdges + let (fr,_) = imLookup edg edges + vgDepGraphVertexFinal fr p v + Just Nothing -> return False + -- Nothing can never happen + +-- | Find the initial node for a nonterminal +vgFindInitial :: Identifier -> VG s VGNode +vgFindInitial nt = do + initial <- gets vgInitial + let Just r = Map.lookup nt initial + return r + +-- | Always succeeding IntMap lookup +imLookup :: Int -> IntMap.IntMap a -> a +imLookup k m = let Just r = IntMap.lookup k m in r + +-- | Trace inside the vg monad +traceVG :: String -> VG s () +traceVG s = trace s (return ()) + +------------------------------------------------------------ +--- The kennedy warren algorithm --- +------------------------------------------------------------ +{- +runVG :: VG s a -> ST s a +insertInitialNode :: NontDependencyInformationM s -> VG s VGNode +createPending :: VGNode -> Set.Set Identifier -> Set.Set Identifier -> VG s VGEdge +selectPending :: VG s VGEdge +getInherited :: VGEdge -> VG s (Set.Set Identifier) +getSynthesized :: VGEdge -> VG s (Set.Set Identifier) +markFinal :: VGEdge -> VG s () +getProductions :: VGEdge -> VG s [VGProd] +onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a +isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool +setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () +getChildState :: VGProd -> Identifier -> VG s VGNode +addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep +addVisitStep :: VGProd -> VisitStep -> VG s () +repeatM :: VG s () -> VG s () +-} + +kennedyWarrenVisitM :: Set.Set NontermIdent -> [NontDependencyInformationM s] -> VG s [Maybe Int] +kennedyWarrenVisitM wr ndis = do + -- Create initial nodes and edges (edges only for wrapper nodes) + initvs <- forM ndis $ \ndi -> do + nd <- insertInitialNode ndi + if (Set.member (ndiNonterminal $ ndimOrig $ ndi) wr) + then do + VGEdge initv <- createPending nd (Set.fromList $ ndiInh $ ndimOrig ndi) (Set.fromList $ ndiSyn $ ndimOrig ndi) + return $ Just initv + else return Nothing + -- Handle all pending edges while there are any + repeatM $ do + pend <- selectPending + prods <- getProductions pend + inhs <- getInherited pend + syns <- getSynthesized pend + -- Handle each production for this edge + forM_ prods $ \prod -> do + -- Find depth of all synthesized child visits + (vis,i) <- foldM (foldChildVisits prod) ([],0) (map (VAttr Syn _LHS) . Set.toList $ syns) + -- Mark them as final + setDepGraphVerticesFinal prod (map fst vis) + -- Change the inherited child visits + vis2 <- forM vis $ \(v,i) -> do + if isChildInh v + then do + preds <- onMarkedDepGraph (liftM Set.toList . flip graphPredecessors v . pdgmDepGraph) prod + let ni = foldl1 min $ map (\x -> case x `lookup` vis of { Just i -> i; Nothing -> 99999999 }) preds + return (v,ni) + else if not $ isChildSyn v + then do + succs <- onMarkedDepGraph (liftM Set.toList . flip graphSuccessors v . pdgmDepGraph) prod + let ni = foldl max 0 $ map (\x -> case x `lookup` vis of { Just i -> i + 1; Nothing -> 0 }) succs + return (v,ni) + else return (v,i) + -- Add all synthesized attributes that are also ready but are not needed + allpreds <- forM vis2 $ \(v,i) -> do + if isChildInh v + then do + preds <- onMarkedDepGraph (liftM Set.toList . flip graphPredecessors v . pdgmDepGraph) prod + return $ Set.fromList $ filter isChildSyn preds + else return Set.empty + lextravis <- mapM (\v -> do ready <- isReadyVertex prod vis2 v + return $ do i <- ready + return (v,i)) $ Set.toList $ Set.unions allpreds + let extravis = catMaybes lextravis + setDepGraphVerticesFinal prod (map fst extravis) + -- Group by visit number and do visit for every num + let gvis = groupSortBy (comparing snd) $ vis2 ++ extravis + forM_ gvis $ \visit -> do + -- Split child visits from rules + let (chattrs, rules) = partition isChildAttr $ map fst visit + -- Evaluate all rules + forM_ (reverse $ rules) $ \rule -> + case rule of + VRule r -> addVisitStep prod $ Sem r + VChild c -> addVisitStep prod $ ChildIntro c + _ -> return () + -- Now group by child, and do a visit for each child + let chs = groupSortBy (comparing getAttrChildName) $ chattrs + chvs <- forM chs $ \childvs -> do -- childs :: [Vertex] + let cinhs = map getAttrName $ filter isChildInh childvs + let csyns = map getAttrName $ filter isChildSyn childvs + let cname = getAttrChildName $ head childvs + -- Insert a new pending edge for this visit + curstate <- getChildState prod cname + target <- createPending curstate (Set.fromList cinhs) (Set.fromList csyns) + addChildVisit prod cname target + -- Add child visits as simultanuous step + when (length chvs > 0) $ do + addVisitStep prod $ Sim chvs + -- Mark this edge as final + markFinal pend + -- We are done + traceVG "Done." + return initvs + +-- | groupBy that groups all equal (according to the function) elements instead of consequtive equal elements +groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]] +groupSortBy f = groupBy (\x y -> f x y == EQ) . sortBy f + +type ChildVisits = [(Vertex,Int)] + +-- | Helper function for folding over child visits +foldChildVisits :: VGProd -> (ChildVisits, Int) -> Vertex -> VG s (ChildVisits, Int) +foldChildVisits prod (vis,i) v = do + (nvis,ni) <- findChildVisits prod v vis + return (nvis, ni `max` i) + +-- | Recursively find all visits to childs +findChildVisits :: VGProd -> Vertex -> ChildVisits -> VG s (ChildVisits, Int) +findChildVisits prod v vis = do + case lookup v vis of + Just i -> return (vis,i) + Nothing -> do + final <- isDepGraphVertexFinal prod v + if final + then return (vis,0) + else do + successors <- onMarkedDepGraph (liftM Set.toList . flip graphSuccessors v . pdgmDepGraph) prod + (nvis,ni) <- foldM (foldChildVisits prod) (vis,0) successors + if isChildSyn v + then return ((v,ni + 1) : nvis, ni + 1) + else return ((v,ni) : nvis, ni) + +-- | Check if a vertex can be marked final in this step (and is not final yet) and return the visit num +isReadyVertex :: VGProd -> ChildVisits -> Vertex -> VG s (Maybe Int) +isReadyVertex prod vis v = do + final <- isDepGraphVertexFinal prod v + if v `elem` (map fst vis) || final + then return Nothing + else do + succ <- onMarkedDepGraph (flip graphSuccessors v . pdgmDepGraph) prod + rd <- mapM (\x -> do case lookup x vis of + Just i -> return $ Just i + Nothing -> do fin <- isDepGraphVertexFinal prod x + return $ if fin then Just 1 else Nothing) (Set.toList succ) + if all isJust rd + then return $ Just $ foldl1 max $ catMaybes rd + else return $ Nothing + +-- | Check if this vertex is a synthesized attribute of a child +isChildSyn :: Vertex -> Bool +isChildSyn v = isChildAttr v && getAttrType v == Syn + +-- | Check if this vertex is an inherited attribute of a child +isChildInh :: Vertex -> Bool +isChildInh v = isChildAttr v && getAttrType v == Inh + +-- | Check if this vertex is an attribute of a child +isChildAttr :: Vertex -> Bool +isChildAttr v = isVertexAttr v && getAttrChildName v /= _LHS && getAttrType v /= Loc + +------------------------------------------------------------ +--- Construction of the execution plan --- +------------------------------------------------------------ +kennedyWarrenExecutionPlan :: [NontDependencyInformationM s] -> [Maybe Int] -> Set.Set NontermIdent + -> TypeSyns -> VG s ExecutionPlan +kennedyWarrenExecutionPlan ndis initvs wr typesyns = do + -- Loop over all nonterminals + nonts <- forM (zip ndis initvs) $ \(ndi, initv) -> do + -- Loop over all productions of this nonterminal + prods <- forM (ndimProds ndi) $ \prod -> do + -- Construct the visits for this production + let inont = ndiNonterminal $ ndimOrig ndi + let iprod = pdgProduction $ pdgmOrig prod + prodvs <- gets vgProdVisits + let thisvisits = filter (\((int,ipr,_),_) -> int == inont && ipr == iprod) $ Map.toList prodvs + visits <- forM thisvisits $ \((_,_,vgedg@(VGEdge edg)),rprodvs) -> do + edges <- gets vgEdges + let (VGNode fr, VGNode to) = imLookup edg edges + steps <- vgInST $ readSTRef rprodvs + inh <- getInherited vgedg + syn <- getSynthesized vgedg + return $ Visit edg fr to inh syn steps + -- Return execution plan for this production + return $ EProduction (pdgProduction $ pdgmOrig prod) + (pdgRules $ pdgmOrig prod) + (pdgChilds $ pdgmOrig prod) + visits + -- Find initial state for this nonterminal + VGNode init <- vgFindInitial $ ndiNonterminal $ ndimOrig ndi + -- Return execution plan for this nonterminal + return $ ENonterminal (ndiNonterminal $ ndimOrig ndi) + (ndiParams $ ndimOrig ndi) + init + initv + prods + -- Return complete execution plan + return $ ExecutionPlan nonts typesyns wr diff --git a/src/Knuth1.hs b/src/Knuth1.hs new file mode 100644 --- /dev/null +++ b/src/Knuth1.hs @@ -0,0 +1,519 @@ +module Knuth1 where + +import Pretty +import ExecutionPlan +import CommonTypes +import Control.Monad +import Control.Monad.ST +import Data.Maybe +import Data.List +import Data.STRef +import Debug.Trace + +import qualified Data.Array as Array +import qualified Data.Map as Map +import qualified Data.Set as Set + +-- | Trace a message in the ST monad +traceST :: String -> ST s () +traceST s = trace s (return ()) + +------------------------------------------------------------------------------- +-- Dependency graph representation +------------------------------------------------------------------------------- + +-- Vertices +data AttrType = Inh | Syn | Loc deriving (Eq, Ord, Show) +data Vertex = VAttr AttrType Identifier Identifier + | VChild Identifier + | VRule Identifier deriving (Eq, Ord) + +instance Show Vertex where + show (VAttr ty ch at) = show ty ++ " @" ++ show ch ++ "." ++ show at + show (VChild ch) = "Child " ++ show ch + show (VRule ru) = "Rule " ++ show ru + +-- | Check if a vertex is an attribute +isVertexAttr :: Vertex -> Bool +isVertexAttr (VAttr _ _ _) = True +isVertexAttr _ = False + +-- | Get the child name of an attribute +getAttrChildName :: Vertex -> Identifier +getAttrChildName (VAttr _ n _) = n + +-- | Set the child name of an attribute +setAttrChildName :: Vertex -> Identifier -> Vertex +setAttrChildName (VAttr t _ a) n = VAttr t n a + +-- | Get the type of an attribute +getAttrType :: Vertex -> AttrType +getAttrType (VAttr t _ _) = t + +-- | Get the name of an attribute +getAttrName :: Vertex -> Identifier +getAttrName (VAttr _ _ a) = a + +-- Edges +type Edge = (Vertex, Vertex) + +-- Internal representation of a vertex +type IVertex = Int +type IEdge = (IVertex, IVertex) + +-- Representation of the graph +data DependencyGraph s = DependencyGraph { vertexIMap :: Map.Map Vertex IVertex + , vertexOMap :: Array.Array IVertex Vertex + , successors :: Array.Array IVertex (STRef s (Set.Set IVertex)) + , predecessors :: Array.Array IVertex (STRef s (Set.Set IVertex)) } + +------------------------------------------------------------------------------- +-- Dependency graph fuctions +------------------------------------------------------------------------------- + +-- | Construct a dependency graph +graphConstruct :: [Vertex] -> ST s (DependencyGraph s) +graphConstruct vs = do let nv = length vs + let ivs = [0..nv-1] + let ivb = (0,nv-1) + let vimap = Map.fromList (zip vs ivs) + let vomap = Array.array ivb (zip ivs vs) + succs <- replicateM nv (newSTRef Set.empty) + preds <- replicateM nv (newSTRef Set.empty) + let su = Array.array ivb (zip ivs succs) + let pr = Array.array ivb (zip ivs preds) + let graph = DependencyGraph { vertexIMap = vimap + , vertexOMap = vomap + , successors = su + , predecessors = pr } + return graph + +-- | Construct a transitivelly closed graph +graphConstructTRC :: [Vertex] -> [Edge] -> ST s (DependencyGraph s) +graphConstructTRC vs es = do g <- graphConstruct vs + -- Insert all initial edges + graphInsertEdgesTRC g es + return g + +-- | Return all successors of a vertex +graphSuccessors :: DependencyGraph s -> Vertex -> ST s (Set.Set Vertex) +graphSuccessors g v = do sucs <- readSTRef $ (successors g) Array.! (graphGetIVertex g v) + return $ Set.map (graphGetVertex g) sucs + +-- | Return all predecessors of a vertex +graphPredecessors :: DependencyGraph s -> Vertex -> ST s (Set.Set Vertex) +graphPredecessors g v = do sucs <- readSTRef $ (predecessors g) Array.! (graphGetIVertex g v) + return $ Set.map (graphGetVertex g) sucs + +-- | Check if the graph contains an edge +graphContainsEdge :: DependencyGraph s -> Edge -> ST s Bool +graphContainsEdge g (v1,v2) = do let iv1 = graphGetIVertex g v1 + let iv2 = graphGetIVertex g v2 + sucs <- readSTRef $ (successors g) Array.! iv1 + return $ iv2 `Set.member` sucs + +-- | Insert an edge in the graph +graphInsert :: DependencyGraph s -> Edge -> ST s () +graphInsert g (v1,v2) = do let iv1 = graphGetIVertex g v1 + let iv2 = graphGetIVertex g v2 + -- Add v2 to the successors of v1 and v1 to predecessors of v2 + modifySTRef ((successors g) Array.! iv1) $ Set.insert iv2 + modifySTRef ((predecessors g) Array.! iv2) $ Set.insert iv1 + +-- | Insert an edge in a transtive closed graph and return all other edges that were +-- added due to transtivity +graphInsertTRC :: DependencyGraph s -> Edge -> ST s [(IVertex, Set.Set IVertex)] +graphInsertTRC g (v1,v2) = do let iv1 = graphGetIVertex g v1 + let iv2 = graphGetIVertex g v2 + -- Read predecessors of v1 and successors of v2 + pred1 <- readSTRef $ (predecessors g) Array.! iv1 + succ2 <- readSTRef $ (successors g) Array.! iv2 + -- First insert all edges from v1 + let rsucc1 = (successors g) Array.! iv1 + succ1 <- readSTRef rsucc1 + let add1 = succ2 `Set.difference` succ1 + modifySTRef rsucc1 (Set.union add1 . Set.insert iv2) + -- All edges to v2 + let rpred2 = (predecessors g) Array.! iv2 + modifySTRef rpred2 (Set.union pred1 . Set.insert iv1) + -- Connect every predecessor of v1 to every successor of v2 + sucl <- forM (Set.toList pred1) $ \pred -> do + -- Connect pred to v2 and all successors of v2 + let rsucc = (successors g) Array.! pred + csucc <- readSTRef rsucc + let cadd = (Set.insert iv2 succ2) `Set.difference` csucc + modifySTRef rsucc (Set.union cadd) + return (pred, cadd) + -- Connect every successor of v2 to every predecessor of v1 + forM_ (Set.toList succ2) $ \succ -> do + -- Connect succ to v1 and all predecessors of v1 + let rpred = (predecessors g) Array.! succ + cpred <- readSTRef rpred + let cadd = (Set.insert iv1 pred1) `Set.difference` cpred + modifySTRef rpred (Set.union cadd) + -- Create return + return $ (iv1,add1) : sucl + +-- | Return all vertices of the graph +graphVertices :: DependencyGraph s -> ST s [Vertex] +graphVertices = return . Array.elems . vertexOMap + +-- | Return all edges of the graph +graphEdges :: DependencyGraph s -> ST s [Edge] +graphEdges g = do let vs = Array.indices $ vertexOMap g + perv <- forM vs $ \v -> do + let rv = graphGetVertex g v + sucs <- readSTRef $ (successors g) Array.! v + let sucl = Set.toList sucs + return $ map ((,) rv . graphGetVertex g) sucl + return $ concat perv + +-- | Insert a list of edges in the graph +graphInsertEdges :: DependencyGraph s -> [Edge] -> ST s () +graphInsertEdges g ed = mapM_ (graphInsert g) ed + +-- | Insert a list of edges in the graph and return all other edges that +-- were added due to transitivity +graphInsertEdgesTRC :: DependencyGraph s -> [Edge] -> ST s [Edge] +graphInsertEdgesTRC g ed = do -- rets :: [[(IVertex, Set.Set IVertex)]] + rets <- mapM (graphInsertTRC g) ed + -- Combine all successor sets + let f :: (IVertex, (Set.Set IVertex)) -> [(IVertex, IVertex)] + f (v,s) = map ((,) v) (Set.toList s) + let comb :: [(IVertex, IVertex)] + comb = concatMap (concatMap f) rets + -- Construct edges from this + return $ map (graphGetEdge g) $ comb + +-- | Check whether the graph is cyclic +graphIsCyclic :: DependencyGraph s -> ST s Bool +graphIsCyclic g = do vs <- return $ Array.indices $ vertexOMap g + selfcyc <- forM vs $ \v -> do + sucs <- readSTRef $ (successors g) Array.! v + return $ v `Set.member` sucs + return $ or selfcyc + +-- | Get internal representation of a vertex +graphGetIVertex :: DependencyGraph s -> Vertex -> IVertex +graphGetIVertex g v = vertexIMap g Map.! v + +-- | Get external representation of a vertex +graphGetVertex :: DependencyGraph s -> IVertex -> Vertex +graphGetVertex g v = vertexOMap g Array.! v + +-- | Get external representation of an edge +graphGetEdge :: DependencyGraph s -> IEdge -> Edge +graphGetEdge g (v1,v2) = (graphGetVertex g v1, graphGetVertex g v2) + +-- | Check if the graph is transitively closed +graphIsTRC :: DependencyGraph s -> ST s Bool +graphIsTRC g = do let vs = Array.indices $ vertexOMap g + bs <- forM vs $ \v -> do + succs <- readSTRef $ (successors g) Array.! v + bs2 <- forM (Set.toList succs) $ \v2 -> do + succs2 <- readSTRef $ (successors g) Array.! v2 + return $ succs2 `Set.isSubsetOf` succs + return $ and bs2 + return $ and bs + +-- | Check consistency of the graph (successor and predecessor sets) +graphCheckConsistency :: DependencyGraph s -> ST s Bool +graphCheckConsistency g = do let vs = Array.indices $ vertexOMap g + ret <- forM vs $ \v -> do + -- V must appear in every predecessor set of its successors + succs <- readSTRef $ (successors g) Array.! v + r1 <- forM (Set.toList succs) $ \succ -> do + preds2 <- readSTRef $ (predecessors g) Array.! succ + return (v `Set.member` preds2) + -- V must appear in every successor set of its predecessors + preds <- readSTRef $ (predecessors g) Array.! v + r2 <- forM (Set.toList preds) $ \pred -> do + succs2 <- readSTRef $ (successors g) Array.! pred + return (v `Set.member` succs2) + return $ and $ r1 ++ r2 + return $ and $ ret + +-- | Add edges to the graph so that it is topologically sorted (this will not work if graph is cyclic) +graphTopSort :: DependencyGraph s -> ST s [Edge] +graphTopSort g = do let vs = Array.indices $ vertexOMap g + order <- foldM (graphTopSort' g) [] vs + mb <- forM (zip order (tail order)) $ \(v1,v2) -> do + let edg = graphGetEdge g (v2,v1) -- order is actually reverse order + ce <- graphContainsEdge g edg + if ce + then return Nothing + else do graphInsert g edg + return $ Just edg + return $ catMaybes mb + +-- | Helper function for graphTopSort +graphTopSort' :: DependencyGraph s -> [IVertex] -> IVertex -> ST s [IVertex] +graphTopSort' g prev cur | cur `elem` prev = return prev + | otherwise = do pred <- readSTRef $ (predecessors g) Array.! cur + order <- foldM (graphTopSort' g) prev $ Set.toList pred + return $ cur : order + +------------------------------------------------------------------------------- +-- Dependency graph information wrappers +------------------------------------------------------------------------------- + +-- | Special wrapper for nonterminal dependency graphs (so that we can easily add other meta-information) +data NontDependencyGraph = NontDependencyGraph { ndgVertices :: [Vertex] + , ndgEdges :: [Edge] } + +-- | Special wrapper for production dependency graphs, including mapping between child names and nonterminals +data ProdDependencyGraph = ProdDependencyGraph { pdgVertices :: [Vertex] + , pdgEdges :: [Edge] + , pdgRules :: ERules + , pdgChilds :: EChildren + , pdgProduction :: Identifier + , pdgChildMap :: [(Identifier, Identifier)] } + + +-- | Represent all information from the dependency graphs for a nonterminal +data NontDependencyInformation = NontDependencyInformation { ndiNonterminal :: Identifier + , ndiParams :: [Identifier] + , ndiInh :: [Identifier] + , ndiSyn :: [Identifier] + , ndiDepGraph :: NontDependencyGraph + , ndiProds :: [ProdDependencyGraph] } + +--- Monadic versions of these records, for use with the ST monad + +-- | Monadic wrapper of NontDependencyGraph +data NontDependencyGraphM s = NontDependencyGraphM { ndgmDepGraph :: DependencyGraph s + , ndgmOrig :: NontDependencyGraph } + +-- | Monadic wrapper of ProdDependencyGraph +data ProdDependencyGraphM s = ProdDependencyGraphM { pdgmDepGraph :: DependencyGraph s + , pdgmOrig :: ProdDependencyGraph } + + +-- | Monadic wrapper of NontDependencyInformation +data NontDependencyInformationM s = NontDependencyInformationM { ndimOrig :: NontDependencyInformation + , ndimDepGraph :: NontDependencyGraphM s + , ndimProds :: [ProdDependencyGraphM s] } + + +-- | Convert a NontDependencyGraph to the corresponding monadic version +mkNontDependencyGraphM :: NontDependencyGraph -> ST s (NontDependencyGraphM s) +mkNontDependencyGraphM ndg = do g <- graphConstructTRC (ndgVertices ndg) (ndgEdges ndg) + return $ NontDependencyGraphM { ndgmDepGraph = g + , ndgmOrig = ndg } + + +-- | Convert a ProdDependencyGraph to the corresponding monadic version +mkProdDependencyGraphM :: Bool -> ProdDependencyGraph -> ST s (ProdDependencyGraphM s) +mkProdDependencyGraphM trc pdg = do g <- if trc + then graphConstructTRC (pdgVertices pdg) (pdgEdges pdg) + else do g <- graphConstruct (pdgVertices pdg) + mapM_ (graphInsert g) (pdgEdges pdg) + return g + return $ ProdDependencyGraphM { pdgmDepGraph = g + , pdgmOrig = pdg } + +-- | Convert a NontDependencyInformation to the corresponding monadic version +mkNontDependencyInformationM :: NontDependencyInformation -> ST s (NontDependencyInformationM s) +mkNontDependencyInformationM ndi = do dg <- mkNontDependencyGraphM (ndiDepGraph ndi) + prods <- mapM (mkProdDependencyGraphM True) (ndiProds ndi) + return $ NontDependencyInformationM { ndimOrig = ndi + , ndimDepGraph = dg + , ndimProds = prods } + +-- | Construct the production graphs from the transitivelly closed graphs +undoTransitiveClosure :: [NontDependencyInformationM s] -> ST s [NontDependencyInformationM s] +undoTransitiveClosure ndis = do edgesl <- mapM (\ndi -> graphEdges (ndgmDepGraph $ ndimDepGraph ndi)) ndis + let edges = concat edgesl + forM ndis $ \ndi -> do + prods <- mapM (mkProdDependencyGraphM False) (ndiProds $ ndimOrig ndi) + forM_ (zip prods (ndimProds ndi)) $ \(nprod,oprod) -> do + -- All possible edges + let possa = do (v1,v2) <- edges + -- Take a child of this nonterminal type + guard $ isVertexAttr v1 + guard $ isVertexAttr v2 + let tp = getAttrChildName v1 + (ch,chtp) <- pdgChildMap $ pdgmOrig nprod + guard $ tp == chtp + -- Construct edge as it should be in the production graph + let nv1 = setAttrChildName v1 ch + let nv2 = setAttrChildName v2 ch + return (nv1, nv2) + toadd <- filterM (graphContainsEdge (pdgmDepGraph oprod)) possa + graphInsertEdges (pdgmDepGraph nprod) toadd + return $ NontDependencyInformationM { ndimOrig = ndimOrig ndi + , ndimDepGraph = ndimDepGraph ndi + , ndimProds = prods } + + +------------------------------------------------------------------------------- +-- Knuth-1 algorithm +------------------------------------------------------------------------------- + +-- | Combine the dependency and nonterminal graphs using Knuth-1 +-- this function assumes that the nonterminal graphs initially contains no edges +knuth1 :: [NontDependencyInformationM s] -> ST s () +knuth1 ndis = do -- Create initial list of pending edges for each ndi per production (initially all prod edges) + let ipending :: NontDependencyInformationM s -> ST s [[Edge]] + ipending = mapM (graphEdges . pdgmDepGraph) . ndimProds +-- pndis :: [([[Edge]], NontDependencyInformation)] + pndis <- mapM (\ndi -> liftM2 (,) (ipending ndi) (return ndi)) ndis + knuth1' pndis + +-- | Helper function for |knuth1| which repeats the process until we are done +knuth1' :: [([[Edge]], NontDependencyInformationM s)] -> ST s () +knuth1' ndis = do -- Add edges from the production graphs to the nonterminal graph +-- ndis' :: [Maybe [Edge]] + ndis' <- mapM addProdNont ndis + -- List of all newly added edges +-- ntedge :: [Edge] + let pntedge = concatMap (\x -> maybe [] id x) ndis' + -- Add backedges + bedges <- addBackEdges ndis + -- All added nonterminal edges + let ntedge = pntedge ++ bedges + if null ntedge + -- When no new edges have been added we are done + then return () + else do -- Otherwise, the next step is to add edges from nonterminal to production graphs +-- ndis'' :: [Maybe [[Edge]]] + ndis'' <- mapM (\(_,x) -> addNontProd True (ntedge, x)) ndis + -- List of new states (production edges + dependency graphs) +-- nndis' :: [([[Edge]], NontDependencyInformation)] + nndis' <- zipWithM (\(_,ndi) me -> return (maybe [] id me, ndi)) ndis ndis'' + if any isJust ndis'' + -- We have added some edges, so continue the process + then knuth1' nndis' + -- No new edges added, we are done + else return () + +-- | Add pending edges from the production graphs to the nonterminal graph, return Nothing if none were added +-- otherwise, return the list of newly added nonterminal edges +addProdNont :: ([[Edge]], NontDependencyInformationM s) -> ST s (Maybe [Edge]) +addProdNont (pending, ndi) = do -- Unwrapping of the records + let nontDepGraph = ndimDepGraph ndi + let nontGraph = ndgmDepGraph nontDepGraph + -- nub the list because multiple productions can result in the same new edges + let possa = nub $ do (v1,v2) <- concat pending + -- Take only edges from syn.lhs to inh.lhs + guard $ isVertexAttr v1 + guard $ getAttrChildName v1 == _LHS + guard $ getAttrType v1 == Syn + guard $ isVertexAttr v2 + guard $ getAttrChildName v2 == _LHS + guard $ getAttrType v2 == Inh + -- Construct edge as it should be in nonterminal graph + let nv1 = setAttrChildName v1 (ndiNonterminal $ ndimOrig ndi) + let nv2 = setAttrChildName v2 (ndiNonterminal $ ndimOrig ndi) + return (nv1, nv2) + -- Edges that are not in the nonterminal graph yet + toadd <- filterM (\e -> return not `ap` graphContainsEdge nontGraph e) possa + -- Check whether new edges are to be added and return the added edges + if null toadd + then return Nothing + else do graphInsertEdgesTRC nontGraph toadd + -- Debug output + --mapM_ (\edge -> traceST $ "Adding nonterminal edge " ++ show edge) toadd + return $ Just toadd + +-- | Add edges from the nonterminal graphs to the production graphs, return Nothing if none were added +-- otherwise, return the list of newly added production edges and the updated graph +addNontProd :: Bool -> ([Edge], NontDependencyInformationM s) -> ST s (Maybe [[Edge]]) +addNontProd trc (pending, ndi) = do -- Call the helper function for each nonterminal + prods' <- mapM (addNontProd' trc pending) (ndimProds ndi) + -- Check if any edges were added + if any isJust prods' + then -- Return list of newly created edges + return $ Just $ map (maybe [] id) prods' + else return Nothing + +-- | Helper function for |addNontProd| for a single production +addNontProd' :: Bool -> [Edge] -> ProdDependencyGraphM s -> ST s (Maybe [Edge]) +addNontProd' trc pend pdg = do -- Unwrapping of the records + prodGraph <- return $ pdgmDepGraph pdg + -- Construct all possible new edges + let possa = do (v1,v2) <- pend + -- Take a child of this nonterminal type + guard $ isVertexAttr v1 + guard $ isVertexAttr v2 + let tp = getAttrChildName v1 + (ch,chtp) <- pdgChildMap $ pdgmOrig pdg + guard $ tp == chtp + -- Construct edge as it should be in the production graph + let nv1 = setAttrChildName v1 ch + let nv2 = setAttrChildName v2 ch + return (nv1, nv2) + -- Edges that are not in the production graph yet + toadd <- filterM (\e -> return not `ap` graphContainsEdge prodGraph e) possa + -- Check whether new edges are to be added and return the result + if null toadd + then return Nothing + else do -- Insert all edges and return transitive edges that are added in this process + ret <- if trc + then graphInsertEdgesTRC prodGraph toadd + else do mapM_ (graphInsert prodGraph) toadd + return [] + -- Debug output + --mapM_ (\edge -> traceST $ "Adding production edge " ++ show edge) toadd + return $ Just ret + +-- | Add the "back edges" to the nonterminal graphs for creating a global ordering +addBackEdges :: [([[Edge]], NontDependencyInformationM s)] -> ST s [Edge] +addBackEdges ndis = do -- gather all backedges + lBackEdges <- forM ndis $ \(aedg,ndi) -> do + -- For every production + bs <- forM (zip aedg (ndimProds ndi)) $ \(edg,prod) -> do + -- Filter out the backedges + return $ do (v1,v2) <- edg + -- Backedges are from inh.ch to syn.ch + guard $ isVertexAttr v1 + guard $ getAttrChildName v1 /= _LHS + guard $ getAttrType v1 == Inh + guard $ isVertexAttr v2 + guard $ getAttrChildName v2 /= _LHS + guard $ getAttrType v2 == Syn + guard $ getAttrChildName v1 == getAttrChildName v2 + -- Find the correct child name + (ch,chtp) <- pdgChildMap $ pdgmOrig prod + let tp = getAttrChildName v1 + guard $ tp == ch + -- Construct the edge as it should be in the nonterminal graph + let nv1 = setAttrChildName v1 chtp + let nv2 = setAttrChildName v2 chtp + return (nv1, nv2) + return $ foldl' union [] bs + -- Concatenate all lists of backedges + let backedges = foldl' union [] lBackEdges + -- Add backedges to every nonterminal graph + ret <- forM ndis $ \(_,ndi) -> do + -- Find the backedges for this nonterminal + let nont = ndiNonterminal . ndimOrig $ ndi + let thisbe = filter ((==) nont . getAttrChildName . fst) backedges + -- Add them to the graph + graphInsertEdgesTRC (ndgmDepGraph . ndimDepGraph $ ndi) thisbe + return $ backedges ++ concat ret + + +-- | Add all resulting edges from a topsort on the nonterminal graph to the production graph +-- this will ignore edges that will make the graph cyclic +addTopSortEdges :: [Edge] -> ProdDependencyGraphM s -> ST s () +addTopSortEdges pend pdg = do -- Unwrapping of the records + prodGraph <- return $ pdgmDepGraph pdg + -- Construct all possible new edges + let possa = do (v1,v2) <- pend + -- Take a child of this nonterminal type + guard $ isVertexAttr v1 + guard $ isVertexAttr v2 + let tp = getAttrChildName v1 + (ch,chtp) <- pdgChildMap $ pdgmOrig pdg + guard $ tp == chtp + -- Construct edge as it should be in the production graph + let nv1 = setAttrChildName v1 ch + let nv2 = setAttrChildName v2 ch + return (nv1, nv2) + -- Edges that are not in the production graph yet + forM_ possa $ \(v1,v2) -> do e1 <- graphContainsEdge prodGraph (v1,v2) + e2 <- graphContainsEdge prodGraph (v2,v1) + when (not $ e1 || e2) $ do + graphInsertTRC prodGraph (v1,v2) + return () diff --git a/src/Options.hs b/src/Options.hs new file mode 100644 --- /dev/null +++ b/src/Options.hs @@ -0,0 +1,285 @@ +module Options where + +import System.Console.GetOpt +import CommonTypes +import Data.Set(Set) +import qualified Data.Set as Set + +options :: [OptDescr (Options -> Options)] +options = [ Option ['m'] [] (NoArg (moduleOpt Nothing)) "generate default module header" + , Option [] ["module"] (OptArg moduleOpt "name") "generate module header, specify module name" + , Option ['d'] ["data"] (NoArg dataOpt) "generate data type definition" + , Option [] ["strictdata"] (NoArg strictDataOpt) "generate strict data fields (when data is generated)" + , Option [] ["strictwrap"] (NoArg strictWrapOpt) "generate strict wrap fields for WRAPPER generated data" + , Option ['c'] ["catas"] (NoArg cataOpt) "generate catamorphisms" + , Option ['f'] ["semfuns"] (NoArg semfunsOpt) "generate semantic functions" + , Option ['s'] ["signatures"] (NoArg signaturesOpt) "generate signatures for semantic functions" + , Option [] ["newtypes"] (NoArg newtypesOpt) "use newtypes instead of type synonyms" + , Option ['p'] ["pretty"] (NoArg prettyOpt) "generate pretty printed list of attributes" + , Option ['w'] ["wrappers"] (NoArg wrappersOpt) "generate wappers for semantic domains" + , Option ['r'] ["rename"] (NoArg renameOpt) "rename data constructors" + , Option [] ["modcopy"] (NoArg modcopyOpt) "use modified copy rule" + , Option [] ["nest"] (NoArg nestOpt) "use nested tuples" + , Option [] ["syntaxmacro"] (NoArg smacroOpt) "experimental: generate syntax macro code (using knit catas)" + , Option ['o'] ["output"] (ReqArg outputOpt "file") "specify output file" + , Option ['v'] ["verbose"] (NoArg verboseOpt) "verbose error message format" + , Option ['h','?'] ["help"] (NoArg helpOpt) "get (this) usage information" + , Option ['a'] ["all"] (NoArg allOpt) ("do everything (-" ++ allc ++ ")") + , Option ['P'] [""] (ReqArg searchPathOpt "search path") ("specify seach path") + , Option [] ["prefix"] (ReqArg prefixOpt "prefix") "set prefix for semantic functions" + , Option [] ["self"] (NoArg selfOpt) "generate self attribute" + , Option [] ["cycle"] (NoArg cycleOpt) "check for cyclic definitions" + , Option [] ["version"] (NoArg versionOpt) "get version information" + , Option ['O'] ["optimize"] (NoArg optimizeOpt) "optimize generated code (--visit --case)" + , Option [] ["visit"] (NoArg visitOpt) "try generating visit functions" + , Option [] ["seq"] (NoArg seqOpt) "force evaluation using function seq (visit functions only)" + , Option [] ["unbox"] (NoArg unboxOpt) "use unboxed tuples" + , Option [] ["bangpats"] (NoArg bangpatsOpt) "use bang patterns (visit functions only)" + , Option [] ["case"] (NoArg casesOpt) "Use nested cases instead of let (visit functions only)" + , Option [] ["strictcase"] (NoArg strictCasesOpt) "Force evaluation of the scrutinee of cases (in generated code, visit functions only)" + , Option [] ["strictercase"] (NoArg stricterCasesOpt) "Force evaluation of all variables bound by a case statement (in generated code)" + , Option [] ["strictsem"] (NoArg strictSemOpt) "Force evaluation of sem-function arguments (in generated code)" + , Option [] ["localcps"] (NoArg localCpsOpt) "Apply a local CPS transformation (in generated code, visit functions only)" + , Option [] ["splitsems"] (NoArg splitSemsOpt) "Split semantic functions into smaller pieces" + , Option [] ["Werrors"] (NoArg werrorsOpt) "Turn warnings into fatal errors" + , Option [] ["Wignore"] (NoArg wignoreOpt) "Ignore warnings" + , Option [] ["Wmax"] (ReqArg wmaxErrsOpt "") "Sets the maximum number of errors that are reported" + , Option [] ["dumpgrammar"] (NoArg dumpgrammarOpt) "Dump internal grammar representation (in generated code)" + , Option [] ["dumpcgrammar"] (NoArg dumpcgrammarOpt) "Dump internal cgrammar representation (in generated code)" + , Option [] ["gentraces"] (NoArg genTracesOpt) "Generate trace expressions (in generated code)" + , Option [] ["genusetraces"] (NoArg genUseTracesOpt) "Generate trace expressions at attribute use sites (in generated code)" + , Option [] ["gencostcentres"] (NoArg genCostCentresOpt) "Generate cost centre pragmas (in generated code)" + , Option [] ["genlinepragmas"] (NoArg genLinePragmasOpt) "Generate GHC LINE pragmas (in generated code)" + , Option [] ["sepsemmods"] (NoArg sepSemModsOpt) "Generate separate modules for semantic functions (in generated code)" + , Option ['M'] ["genfiledeps"] (NoArg genFileDepsOpt) "Generate a list of dependencies on the input AG files" + , Option [] ["genvisage"] (NoArg genVisageOpt) "Generate output for the AG visualizer Visage" + , Option [] ["genAspectAG"] (NoArg genAspectAGOpt) "Generate AspectAG file" + , Option [] ["genattrlist"] (NoArg genAttrListOpt) "Generate a list of all explicitly defined attributes (outside irrefutable patterns)" + , Option [] ["forceirrefutable"] (OptArg forceIrrefutableOpt "file") "Force a set of explicitly defined attributes to be irrefutable, specify file containing the attribute set" + , Option [] ["uniquedispenser"] (ReqArg uniqueDispenserOpt "name") "The Haskell function to call in the generated code" + , Option [] ["lckeywords"] (NoArg lcKeywordsOpt) "Use lowercase keywords (sem, attr) instead of the uppercase ones (SEM, ATTR)" + , Option [] ["doublecolons"] (NoArg doubleColonsOpt) "Use double colons for type signatures instead of single colons" + , Option ['H'] ["haskellsyntax"] (NoArg haskellSyntaxOpt) "Use Haskell like syntax (equivalent to --lckeywords and --doublecolons --genlinepragmas)" + , Option [] ["monadic"] (NoArg monadicOpt) "Experimental: generate monadic code" + , Option [] ["ocaml"] (NoArg ocamlOpt) "Experimental: generate Ocaml code" + , Option [] ["breadthfirst"] (NoArg breadthfirstOpt) "Experimental: generate breadth-first code" + , Option [] ["breadthfirst-strict"] (NoArg breadthfirstStrictOpt) "Experimental: outermost breadth-first evaluator is strict instead of lazy" + , Option [] ["visitcode"] (NoArg visitorsOutputOpt) "Experimental: generate visitors code" + , Option [] ["kennedywarren"] (NoArg kennedyWarrenOpt) "Experimental: use Kennedy-Warren's algorithm for ordering" + , Option [] ["statistics"] (ReqArg statisticsOpt "FILE to append to") "Append statistics to FILE" + , Option [] ["checkParseRhs"] (NoArg parseHsRhsOpt) "Parse RHS of rules with Haskell parser" + , Option [] ["checkParseTys"] (NoArg parseHsTpOpt) "Parse types of attrs with Haskell parser" + , Option [] ["checkParseBlocks"] (NoArg parseHsBlockOpt) "Parse blocks with Haskell parser" + , Option [] ["checkParseHaskell"] (NoArg parseHsOpt) "Parse Haskell code (recognizer)" + , Option [] ["nocatas"] (ReqArg nocatasOpt "list of nonterms") "Nonterminals not to generate catas for" + ] + +allc = "dcfsprm" + +data Options = Options{ moduleName :: ModuleHeader + , dataTypes :: Bool + , strictData :: Bool + , strictWrap :: Bool + , folds :: Bool + , semfuns :: Bool + , typeSigs :: Bool + , attrInfo :: Bool + , rename :: Bool + , wrappers :: Bool + , modcopy :: Bool + , newtypes :: Bool + , nest :: Bool + , smacro :: Bool + , outputFiles :: [String] + , searchPath :: [String] + , verbose :: Bool + , prefix :: String + , withSelf :: Bool + , withCycle :: Bool + , showHelp :: Bool + , showVersion :: Bool + , visit :: Bool + , withSeq :: Bool + , unbox :: Bool + , bangpats :: Bool + , cases :: Bool + , strictCases :: Bool + , stricterCases :: Bool + , strictSems :: Bool + , localCps :: Bool + , splitSems :: Bool + , werrors :: Bool + , wignore :: Bool + , wmaxerrs :: Int + , dumpgrammar :: Bool + , dumpcgrammar :: Bool + , genTraces :: Bool + , genUseTraces :: Bool + , genCostCentres :: Bool + , sepSemMods :: Bool + , genFileDeps :: Bool + , genLinePragmas :: Bool + , genvisage :: Bool + , genAspectAG :: Bool + , genAttributeList :: Bool + , forceIrrefutables :: Maybe String + , uniqueDispenser :: String + , lcKeywords :: Bool + , doubleColons :: Bool + , monadic :: Bool + , ocaml :: Bool + , visitorsOutput :: Bool + , statsFile :: Maybe String + , breadthFirst :: Bool + , breadthFirstStrict :: Bool + , checkParseRhs :: Bool + , checkParseTy :: Bool + , checkParseBlock :: Bool + , nocatas :: Set NontermIdent + , kennedyWarren :: Bool + } deriving Show +noOptions = Options { moduleName = NoName + , dataTypes = False + , strictData = False + , strictWrap = False + , folds = False + , semfuns = False + , typeSigs = False + , attrInfo = False + , rename = False + , wrappers = False + , modcopy = False + , newtypes = False + , nest = False + , smacro = False + , outputFiles = [] + , searchPath = [] + , verbose = False + , showHelp = False + , showVersion = False + , prefix = "sem_" + , withSelf = False + , withCycle = False + , visit = False + , withSeq = False + , unbox = False + , bangpats = False + , cases = False + , strictCases = False + , stricterCases = False + , strictSems = False + , localCps = False + , splitSems = False + , werrors = False + , wignore = False + , wmaxerrs = 99999 + , dumpgrammar = False + , dumpcgrammar = False + , genTraces = False + , genUseTraces = False + , genCostCentres = False + , sepSemMods = False + , genFileDeps = False + , genLinePragmas = False + , genvisage = False + , genAspectAG = False + , genAttributeList = False + , forceIrrefutables = Nothing + , uniqueDispenser = "nextUnique" + , lcKeywords = False + , doubleColons = False + , monadic = False + , ocaml = False + , visitorsOutput = False + , statsFile = Nothing + , breadthFirst = False + , breadthFirstStrict = False + , checkParseRhs = False + , checkParseTy = False + , checkParseBlock = False + , nocatas = Set.empty + , kennedyWarren = False + } + +moduleOpt nm opts = opts{moduleName = maybe Default Name nm} +dataOpt opts = opts{dataTypes = True} +strictDataOpt opts = opts{strictData = True} +strictWrapOpt opts = opts{strictWrap = True} +cataOpt opts = opts{folds = True} +semfunsOpt opts = opts{semfuns = True} +signaturesOpt opts = opts{typeSigs = True} +prettyOpt opts = opts{attrInfo = True} +renameOpt opts = opts{rename = True} +wrappersOpt opts = opts{wrappers = True} +modcopyOpt opts = opts{modcopy = True} +newtypesOpt opts = opts{newtypes = True} +nestOpt opts = opts{nest = True} +smacroOpt opts = opts{smacro = True} +verboseOpt opts = opts{verbose = True} +helpOpt opts = opts{showHelp = True} +versionOpt opts = opts{showVersion = True} +prefixOpt pre opts = opts{prefix = pre } +selfOpt opts = opts{withSelf = True} +cycleOpt opts = opts{withCycle = True} +visitOpt opts = opts{visit = True, withCycle = True} +seqOpt opts = opts{withSeq = True} +unboxOpt opts = opts{unbox = True} +bangpatsOpt opts = opts{bangpats = True} +casesOpt opts = opts{cases = True} +strictCasesOpt opts = opts{strictCases = True} +stricterCasesOpt opts = opts{strictCases = True, stricterCases = True} +strictSemOpt opts = opts{strictSems = True} +localCpsOpt opts = opts{localCps = True} +splitSemsOpt opts = opts{splitSems = True} +werrorsOpt opts = opts{werrors = True} +wignoreOpt opts = opts{wignore = True} +wmaxErrsOpt n opts = opts{wmaxerrs = read n} +dumpgrammarOpt opts = opts{dumpgrammar = True} +dumpcgrammarOpt opts = opts{dumpcgrammar = True} +genTracesOpt opts = opts{genTraces = True} +genUseTracesOpt opts = opts{genUseTraces = True} +genCostCentresOpt opts = opts{genCostCentres = True} +sepSemModsOpt opts = opts{sepSemMods = True} +genFileDepsOpt opts = opts{genFileDeps = True} +genLinePragmasOpt opts = opts{genLinePragmas = True} +genVisageOpt opts = opts{genvisage = True } +genAspectAGOpt opts = opts{genAspectAG = True} +genAttrListOpt opts = opts { genAttributeList = True } +forceIrrefutableOpt mbNm opts = opts { forceIrrefutables = mbNm } +uniqueDispenserOpt nm opts = opts { uniqueDispenser = nm } +lcKeywordsOpt opts = opts { lcKeywords = True } +doubleColonsOpt opts = opts { doubleColons = True } +haskellSyntaxOpt = lcKeywordsOpt . doubleColonsOpt . genLinePragmasOpt +monadicOpt opts = opts { monadic = True } +ocamlOpt opts = opts { ocaml = True } +visitorsOutputOpt opts = opts { visitorsOutput = True } +statisticsOpt nm opts = opts { statsFile = Just nm } +breadthfirstOpt opts = opts { breadthFirst = True } +breadthfirstStrictOpt opts = opts { breadthFirstStrict = True } +parseHsRhsOpt opts = opts { checkParseRhs = True } +parseHsTpOpt opts = opts { checkParseTy = True } +parseHsBlockOpt opts = opts { checkParseBlock = True } +parseHsOpt = parseHsRhsOpt . parseHsTpOpt . parseHsBlockOpt +kennedyWarrenOpt opts = opts { kennedyWarren = True } +nocatasOpt str opts = opts { nocatas = set `Set.union` nocatas opts } where + set = Set.fromList ids + ids = map identifier lst + lst = split str + + split str | null p = [] + | otherwise = p : split ps + where (p,ps) = break (== ',') str + +outputOpt file opts = opts{outputFiles = file : outputFiles opts} +searchPathOpt path opts = opts{searchPath = extract path ++ searchPath opts} + where extract xs = let (p,ps) = break (\x -> x == ';' || x == ':') xs + in if null p then [] else p : extract ps +allOpt = moduleOpt Nothing . dataOpt . cataOpt . semfunsOpt . signaturesOpt . prettyOpt . renameOpt +optimizeOpt = visitOpt . casesOpt + +getOptions args = let (flags,files,errors) = getOpt Permute options args + in (foldl (flip ($)) noOptions flags,files,errors) + +data ModuleHeader = NoName + | Name String + | Default deriving Show diff --git a/src/PPUtil.hs b/src/PPUtil.hs new file mode 100644 --- /dev/null +++ b/src/PPUtil.hs @@ -0,0 +1,51 @@ +module PPUtil where + +-- +-- Some additional pretty-print functions +-- for pretty-printing abstract syntax trees. +-- + +import Data.List +import qualified Data.Map as Map +import Pretty + +ppListSep :: (PP s, PP c, PP o, PP a) => o -> c -> s -> [a] -> PP_Doc +ppListSep o c s pps = o >|< hlist (intersperse (pp s) (map pp pps)) >|< c + +ppSpaced :: PP a => [a] -> PP_Doc +ppSpaced = ppListSep "" "" " " + +ppCommas :: PP a => [a] -> PP_Doc +ppCommas = ppListSep "" "" ", " + +ppVList :: PP a => [a] -> PP_Doc +ppVList = pp_block "[ " "] " ", " . map pp + +ppMap :: (Show a, Show b) => Map.Map a b -> PP_Doc +ppMap m = ppVList [ ppF (show k) $ ppShow v | (k,v) <- Map.toList m ] + +ppAssocL :: (Show a, Show b) => [(a,b)] -> PP_Doc +ppAssocL m = ppVList [ ppF (show k) $ ppShow v | (k,v) <- m ] + +ppF :: String -> PP_Doc -> PP_Doc +ppF s x = s >|< ":" >#< x + +ppNest :: PP a => [a] -> [PP_Doc] -> [PP_Doc] -> PP_Doc +ppNest nms attrs ps = ppNestInfo {- defaultEHCOpts -} nms attrs ps [] + +ppNestInfo :: PP a => {- EHCOpts -> -} [a] -> [PP_Doc] -> [PP_Doc] -> [(String,PP_Doc)] -> PP_Doc +ppNestInfo {- opts -} nms attrs ps infos + = ppListSep "" "" "_" nms + >#< ( (if null attrs then empty else ppSpaced attrs) + >-< (if False {- ehcOptDebug opts -} then vlist (map (\(i,p) -> pp i >|< ":" >#< p) infos) else empty) + ) + >-< indent 2 (vlist ps) + +ppNm :: String -> PP_Doc +ppNm = text . show + +ppShow :: Show x => x -> PP_Doc +ppShow x = pp $ show x + +mkInfo1 :: String -> PP_Doc -> (String,PP_Doc) +mkInfo1 = (,) diff --git a/src/Parser.hs b/src/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Parser.hs @@ -0,0 +1,495 @@ +module Parser +where +import Data.Maybe +import UU.Parsing +import UU.Parsing.Machine(RealParser(..),RealRecogn(..),anaDynE,mkPR) +import ConcreteSyntax +import CommonTypes +import Patterns +import UU.Pretty(text,PP_Doc,empty,(>-<)) +import TokenDef +import List (intersperse) +import Char +import Scanner (Input(..),scanLit,input) +import List +import Expression +import UU.Scanner.Token +import UU.Scanner.TokenParser +import UU.Scanner.GenToken +import UU.Scanner.GenTokenParser +import UU.Scanner.Position +import UU.Scanner.TokenShow() +import System.Directory +import System.FilePath +import HsTokenScanner +import Options + + +type AGParser = AnaParser Input Pair Token Pos + +pIdentifier, pIdentifierU :: AGParser Identifier +pIdentifierU = uncurry Ident <$> pConidPos +pIdentifier = uncurry Ident <$> pVaridPos + + +parseAG :: Options -> [FilePath] -> String -> IO (AG,[Message Token Pos]) +parseAG opts searchPath file + = do (es,_,_,mesg) <- parseFile opts searchPath file + return (AG es, mesg) + +depsAG :: Options -> [FilePath] -> String -> IO ([String], [Message Token Pos]) +depsAG opts searchPath file + = do (_,_,fs,mesgs) <- parseFile opts searchPath file + return (fs, mesgs) + +parseFile :: Options -> [FilePath] -> String -> IO ([Elem],[String],[String],[Message Token Pos ]) +parseFile opts searchPath file + = do txt <- readFile file + let litMode = ".lag" `isSuffixOf` file + (files,text) = if litMode then scanLit txt + else ([],txt) + tokens = input opts (initPos file) text + + steps = parse pElemsFiles tokens + stop (_,fs,_,_) = null fs + cont (es,fs,allfs,msg) + = do files <- mapM (resolveFile searchPath) fs + res <- mapM (parseFile opts searchPath) files + let (ess,fss,allfss, msgs) = unzip4 res + return (es ++ concat ess, concat fss, concat allfss ++ allfs, msg ++ concat msgs) + let (Pair (es,fls) _ ,mesg) = evalStepsMessages steps + let allfs = files ++ fls + loopp stop cont (es,allfs,allfs,mesg) + where + + -- + -- Option dependent AG Parsers inlined here + -- to have access to the opts + -- while retaining sharing + -- + + pElemsFiles :: AGParser ([Elem],[String]) + pElemsFiles = pFoldr (($),([],[])) pElem' + where pElem' = addElem <$> pElem + <|> pINCLUDE *> (addInc <$> pStringPos) + addElem e (es,fs) = (e:es, fs) + addInc (fn,_) (es,fs) = ( es,fn:fs) + + pCodescrapL = (\(ValToken _ str pos) -> (str, pos))<$> + parseScrapL "a code block" + + parseScrapL :: AGParser Token + parseScrapL + = let p acc = (\k (Input pos str next) -> + let (sc,rest) = case next of + Just (t@(ValToken TkTextln _ _), rs) -> (t,rs) + _ -> let (tok,p2,inp2) = codescrapL pos str + in (tok, input opts p2 inp2) + steps = k ( rest) + in (val (acc sc) steps) + ) + in anaDynE (mkPR (P (p ), R (p (const id)))) + + pElems :: AGParser Elems + pElems = pList_ng pElem + + pComplexType = List <$> pBracks pTypeEncapsulated + <|> Maybe <$ pMAYBE <*> pType + <|> Either <$ pEITHER <*> pType <*> pType + <|> Map <$ pMAP <*> pTypePrimitive <*> pType + <|> IntMap <$ pINTMAP <*> pType + <|> tuple <$> pParens (pListSep pComma field) + where field = (,) <$> ((Just <$> pIdentifier <* pTypeColon) `opt` Nothing) <*> pTypeEncapsulated + tuple xs = Tuple [(fromMaybe (Ident ("x"++show n) noPos) f, t) + | (n,(f,t)) <- zip [1..] xs + ] + + pElem :: AGParser Elem + pElem + = Data <$> pDATA + <*> pOptClassContext + <*> pNontSet + <*> pList pIdentifier + <*> pOptAttrs + <*> pAlts + <*> pSucceed False + <|> Attr <$> pATTR + <*> pOptClassContext + <*> pNontSet + <*> pOptQuantifiers + <*> pAttrs + <|> Type <$> pTYPE + <*> pOptClassContext + <*> pIdentifierU + <*> pList pIdentifier + <* pEquals + <*> pComplexType + <|> Sem <$> pSEM + <*> pOptClassContext + <*> pNontSet + <*> pOptAttrs + <*> pOptQuantifiers + <*> pSemAlts + <|> Set <$> pSET + <*> pIdentifierU + <*> ( False <$ pEquals + <|> True <$ pColon + ) + <*> pNontSet + <|> Deriving + <$> pDERIVING + <*> pNontSet + <* pColon + <*> pListSep pComma pIdentifierU + <|> Wrapper + <$> pWRAPPER + <*> pNontSet + <|> Nocatas + <$> pNOCATAS + <*> pNontSet + <|> Pragma + <$> pPRAGMA + <*> pNames + <|> Module + <$> pMODULE + <*> pCodescrap' + <*> pCodescrap' + <*> pCodescrap' + <|> codeBlock <$> (pIdentifier <|> pSucceed (Ident "" noPos)) <*> ((Just <$ pATTACH <*> pIdentifierU) <|> pSucceed Nothing) <*> pCodeBlock "a statement" + where codeBlock nm mbNt (txt,pos) = Txt pos nm mbNt (lines txt) + + + pAttrs :: AGParser Attrs + pAttrs + = Attrs <$> pOBrackPos <*> (concat <$> pList pInhAttrNames "inherited attribute declarations") + <* pBar <*> (concat <$> pList pAttrNames "chained attribute declarations" ) + <* pBar <*> (concat <$> pList pAttrNames "synthesised attribute declarations" ) + <* pCBrack + <|> (\ds -> Attrs (fst $ head ds) [n | (_,(nms,_,_)) <- ds, n <- nms] [n | (_,(_,nms,_)) <- ds, n <- nms] [n | (_,(_,_,nms)) <- ds, n <- nms]) <$> pList1 pSingleAttrDefs + + pSingleAttrDefs :: AGParser (Pos, (AttrNames, AttrNames, AttrNames)) + pSingleAttrDefs + = (\p is -> (p, (is,[],[]))) <$> pINH <*> pList1Sep pComma pSingleInhAttrDef + <|> (\p is -> (p, ([],[],is))) <$> pSYN <*> pList1Sep pComma pSingleSynAttrDef + <|> (\p is -> (p, ([],is,[]))) <$> pCHN <*> pList1Sep pComma pSingleChnAttrDef + + pSingleInhAttrDef :: AGParser (Identifier,Type,(String,String,String)) + pSingleInhAttrDef + = (\v tp -> (v,tp,("","",""))) <$> pIdentifier <* pTypeColon <*> pType "inh attribute declaration" + + pSingleSynAttrDef :: AGParser (Identifier,Type,(String,String,String)) + pSingleSynAttrDef + = (\v u tp -> (v,tp,u)) <$> pIdentifier <*> pUse <* pTypeColon <*> pType "syn attribute declaration" + + pSingleChnAttrDef :: AGParser (Identifier,Type,(String,String,String)) + pSingleChnAttrDef + = (\v tp -> (v,tp,("","",""))) <$> pIdentifier <* pTypeColon <*> pType "chn attribute declaration" + + pOptAttrs :: AGParser Attrs + pOptAttrs = pAttrs `opt` Attrs noPos [] [] [] + + pInhAttrNames :: AGParser AttrNames + pInhAttrNames + = (\vs tp -> map (\v -> (v,tp,("","",""))) vs) + <$> pIdentifiers <* pTypeColon <*> pType "attribute declarations" + + pAttrNames :: AGParser AttrNames + pAttrNames + = (\vs use tp -> map (\v -> (v,tp,use)) vs) + <$> pIdentifiers <*> pUse <* pTypeColon <*> pType "attribute declarations" + + pAlt :: AGParser Alt + pAlt = Alt <$> pBar <*> pSimpleConstructorSet <*> pFields "a datatype alternative" + + pAlts :: AGParser Alts + pAlts = pList_ng pAlt "datatype alternatives" + + pFields :: AGParser Fields + pFields = concat <$> pList_ng pField "fields" + + pField :: AGParser Fields + pField + = (\nms tp -> map (flip (,) tp) nms) + <$> pIdentifiers <* pTypeColon <*> pType + <|> (\s -> [(Ident (mklower (getName s)) (getPos s) ,NT s [])]) <$> pIdentifierU + + pSemAlt :: AGParser SemAlt + pSemAlt = SemAlt <$> pBar <*> pConstructorSet <*> pSemDefs "SEM alternative" + + pSemAlts :: AGParser SemAlts + pSemAlts = pList pSemAlt "SEM alternatives" + + pSemDef :: AGParser [SemDef] + pSemDef + = (\x y fs -> map (\f -> f x y) fs) <$> pMaybeRuleName <*> pFieldIdentifier <*> pList1 pAttrDef + <|> pLOC *> pList1 pLocDecl + <|> pINST *> pList1 pInstDecl + <|> pSEMPRAGMA *> pList1 (SemPragma <$> pNames) + <|> (\n e -> [AugmentDef n e]) <$ pAugmentToken <*> pIdentifier <* pAssign <*> pExpr + <|> (\n e -> [AroundDef n e]) <$ pAROUND <*> pIdentifier <* pAssign <*> pExpr + <|> (\a b -> [AttrOrderBefore a [b]]) <$> pList1 pAttrOrIdent <* pSmaller <*> pAttrOrIdent + <|> (\sources target nt expr -> [MergeDef target nt sources expr]) <$ pMERGE <*> (pList1_ng pIdentifier <* pAS <|> pSucceed []) <*> pIdentifier <* pTypeColon <*> pIdentifierU <* pAssign <*> pExpr + <|> (\mbNm pat (owrt,pos) exp -> [Def pos mbNm (pat ()) exp owrt]) <$> pMaybeRuleName <*> pPattern (const <$> pAttr) <*> pAssignPos <*> pExpr + + pMaybeRuleName :: AGParser (Maybe Identifier) + pMaybeRuleName + = (Just <$> pIdentifier <* pColon "rule name") + <|> pSucceed Nothing + + pAttrDef :: AGParser (Maybe Identifier -> Identifier -> SemDef) + pAttrDef + = (\pat (owrt,pos) exp mbNm fld -> Def pos mbNm (pat fld) exp owrt) + <$ pDot <*> pattern <*> pAssignPos <*> pExpr + where pattern = pPattern pVar + <|> (\ir a fld -> ir $ Alias fld a (Underscore noPos) []) <$> ((Irrefutable <$ pTilde) `opt` id) <*> pIdentifier + + pLocDecl :: AGParser SemDef + pLocDecl = pDot <**> (pIdentifier <**> (pTypeColon <**> ( (\(tp,pos) _ ident _ -> TypeDef pos ident tp) <$> pLocType + <|> (\ref _ ident _ -> UniqueDef ident ref) <$ pUNIQUEREF <*> pIdentifier ))) + + + pInstDecl :: AGParser SemDef + pInstDecl = (\ident tp -> TypeDef (getPos ident) ident tp) + <$ pDot <*> pIdentifier <* pTypeColon <*> pTypeNt + + pSemDefs :: AGParser SemDefs + pSemDefs = concat <$> pList_ng pSemDef "attribute rules" + + pExpr :: AGParser Expression + pExpr = (\(str,pos) -> Expression pos (lexTokens pos str)) <$> pCodescrapL "an expression" + + pTypeColon :: AGParser Pos + pTypeColon + = if doubleColons opts + then pDoubleColon + else pColon + + -- + -- End of AG Parser + -- + +resolveFile :: [FilePath] -> FilePath -> IO FilePath +resolveFile path fname = search (path ++ ["."]) + where search (p:ps) = do let filename = joinPath [p, fname] + fExists <- doesFileExist filename + if fExists + then return filename + else search ps + search [] = error ("File: " ++ show fname ++ " not found in search path: " ++ show (concat (intersperse ";" (path ++ ["."]))) ) + +pathSeparator = "/" + +evalStepsMessages :: (Eq s, Show s, Show p) => Steps a s p -> (a,[Message s p]) +evalStepsMessages steps = case steps of + OkVal v rest -> let (arg,ms) = evalStepsMessages rest + in (v arg,ms) + Ok rest -> evalStepsMessages rest + Cost _ rest -> evalStepsMessages rest + StRepair _ msg rest -> let (v,ms) = evalStepsMessages rest + in (v, msg:ms) + Best _ rest _ -> evalStepsMessages rest + NoMoreSteps v -> (v,[]) + +loopp ::(a->Bool) -> (a->IO a) -> a -> IO a +loopp pred cont x | pred x = return x + | otherwise = do x' <- cont x + loopp pred cont x' + +codescrapL p [] = (valueToken TkTextln "" p,p,[]) +codescrapL p (x:xs) | isSpace x = (updPos' x p) codescrapL xs + | otherwise = let refcol = column p + (p',sc,rest) = scrapL refcol p (x:xs) + in (valueToken TkTextln sc p,p',rest) + +scrapL ref p (x:xs) | isSpace x || column p >= ref = + let (p'',sc,inp) = updPos' x p (scrapL ref) xs + in (p'',x:sc,inp) + | otherwise =(p,[],x:xs) +scrapL ref p [] = (p,[],[]) + +pNontSet = set0 + where set0 = pChainr (Intersect <$ pIntersect) set1 + set1 = pChainl (Difference <$ pMinus) set2 + set2 = pChainr (pSucceed Union) set3 + set3 = pIdentifierU <**> opt (flip Path <$ pArrow <*> pIdentifierU) NamedSet + <|> All <$ pStar + <|> pParens set0 + +pNames :: AGParser [Identifier] +pNames = pList1 pIdentifier + + + + +-- Insertion is expensive for pCodeBlock in order to prevent infinite inserts. +pCodeBlock :: AGParser (String,Pos) +pCodeBlock = pCostValToken 90 TkTextln "" "a code block" + +pOptClassContext :: AGParser ClassContext +pOptClassContext + = pClassContext <* pDoubleArrow + <|> pSucceed [] + +pClassContext :: AGParser ClassContext +pClassContext + = pListSep pComma ((,) <$> pIdentifierU <*> pList pTypeHaskellAnyAsString) + +pOptQuantifiers :: AGParser [String] +pOptQuantifiers = (return <$ pDoubleColon <*> pCodescrap') `opt` [] + +pTypeNt :: AGParser Type +pTypeNt + = ((\nt -> NT nt []) <$> pIdentifierU "nonterminal name (no brackets)") + <|> (pParens (NT <$> pIdentifierU <*> pList pTypeHaskellAnyAsString) "nonterminal name with parameters (using parenthesis)") + +pTypeHaskellAnyAsString :: AGParser String +pTypeHaskellAnyAsString + = getName <$> pIdentifier + <|> getName <$> pIdentifierU + <|> pCodescrap' "a type" + +-- if the type is within some kind of parentheses or brackets (then we allow lowercase identifiers as well) +pTypeEncapsulated :: AGParser Type +pTypeEncapsulated + = pParens pTypeEncapsulated + <|> NT <$> pIdentifierU <*> pList pTypeHaskellAnyAsString + <|> (Haskell . getName) <$> pIdentifier + <|> pTypePrimitive + +pTypePrimitive :: AGParser Type +pTypePrimitive + = Haskell <$> pCodescrap' "a type" + +pType :: AGParser Type +pType = pTypeNt + <|> pTypePrimitive + +pIdentifiers :: AGParser [Identifier] +pIdentifiers = pList1Sep pComma pIdentifier "lowercase identifiers" + +pUse :: AGParser (String,String,String) +pUse = ( (\u x y->(x,y,show u)) <$> pUSE <*> pCodescrap' <*> pCodescrap') `opt` ("","","") "USE declaration" + +mklower :: String -> String +mklower (x:xs) = toLower x : xs +mklower [] = [] + +pSimpleConstructorSet :: AGParser ConstructorSet +pSimpleConstructorSet = CName <$> pIdentifierU + <|> CAll <$ pStar + <|> pParens pConstructorSet + +pConstructorSet :: AGParser ConstructorSet +pConstructorSet = pChainl (CDifference <$ pMinus) term2 + where term2 = pChainr (pSucceed CUnion) term1 + term1 = CName <$> pIdentifierU + <|> CAll <$ pStar + +pFieldIdentifier :: AGParser Identifier +pFieldIdentifier = pIdentifier + <|> Ident "lhs" <$> pLHS + <|> Ident "loc" <$> pLOC + <|> Ident "inst" <$> pINST + +pAugmentToken :: AGParser () +pAugmentToken = () <$ (pAUGMENT <|> pPlus) + +pAttr = (,) <$> pFieldIdentifier <* pDot <*> pIdentifier + +pAttrOrIdent + = OccAttr <$> pFieldIdentifier <* pDot <*> pIdentifier + <|> OccRule <$> pIdentifier + +nl2sp :: Char -> Char +nl2sp '\n' = ' ' +nl2sp '\r' = ' ' +nl2sp x = x + +pLocType :: AGParser (Type, Pos) +pLocType = (\u -> (Haskell $ getName u, getPos u)) <$> pIdentifierU + <|> (\(s,p) -> (Haskell s,p)) <$> pCodescrap "a type" + +pVar :: AGParser (Identifier -> (Identifier, Identifier)) +pVar = (\att fld -> (fld,att)) <$> pIdentifier + +pAssign :: AGParser Bool +pAssign = False <$ pReserved "=" + <|> True <$ pReserved ":=" + +pAssignPos :: AGParser (Bool, Pos) +pAssignPos = (\p -> (False,p)) <$> pReserved "=" + <|> (\p -> (True,p)) <$> pReserved ":=" + +pPattern :: AGParser (a -> (Identifier,Identifier)) -> AGParser (a -> Pattern) +pPattern pvar = pPattern2 where + pPattern0 = (\i pats a -> Constr i (map ($ a) pats)) + <$> pIdentifierU <*> pList pPattern1 + <|> pPattern1 "a pattern" + pPattern1 = pvariable + <|> pPattern2 + pvariable = (\ir var pat a -> case var a of (fld,att) -> ir $ Alias fld att (pat a) []) + <$> ((Irrefutable <$ pTilde) `opt` id) <*> pvar <*> ((pAt *> pPattern1) `opt` const (Underscore noPos)) + pPattern2 = (mkTuple <$> pOParenPos <*> pListSep pComma pPattern0 <* pCParen ) + <|> (const . Underscore) <$> pUScore "a pattern" + where mkTuple _ [x] a = x a + mkTuple p xs a = Product p (map ($ a) xs) + +pCostSym' c t = pCostSym c t t + +pCodescrap' :: AGParser String +pCodescrap' = fst <$> pCodescrap + +pCodescrap :: AGParser (String,Pos) +pCodescrap = pCodeBlock + +pSEM, pATTR, pDATA, pUSE, pLOC,pINCLUDE, pTYPE, pEquals, pColonEquals, pTilde, + pBar, pColon, pLHS,pINST,pSET,pDERIVING,pMinus,pIntersect,pDoubleArrow,pArrow, + pDot, pUScore, pEXT,pAt,pStar, pSmaller, pWRAPPER, pNOCATAS, pPRAGMA, pMAYBE, pEITHER, pMAP, pINTMAP, + pMODULE, pATTACH, pUNIQUEREF, pINH, pSYN, pAUGMENT, pPlus, pAROUND, pSEMPRAGMA, pMERGE, pAS + :: AGParser Pos +pSET = pCostReserved 90 "SET" "SET" +pDERIVING = pCostReserved 90 "DERIVING" "DERIVING" +pWRAPPER = pCostReserved 90 "WRAPPER" "WRAPPER" +pNOCATAS = pCostReserved 90 "NOCATAS" "NOCATAS" +pPRAGMA = pCostReserved 90 "PRAGMA" "PRAGMA" +pSEMPRAGMA = pCostReserved 90 "SEMPRAGMA" "SEMPRAGMA" +pATTACH = pCostReserved 90 "ATTACH" "ATTACH" +pDATA = pCostReserved 90 "DATA" "DATA" +pEXT = pCostReserved 90 "EXT" "EXT" +pATTR = pCostReserved 90 "ATTR" "ATTR" +pSEM = pCostReserved 90 "SEM" "SEM" +pINCLUDE = pCostReserved 90 "INCLUDE" "INCLUDE" +pTYPE = pCostReserved 90 "TYPE" "TYPE" +pINH = pCostReserved 90 "INH" "INH" +pSYN = pCostReserved 90 "SYN" "SYN" +pCHN = pCostReserved 90 "CHN" "CHN" +pMAYBE = pCostReserved 5 "MAYBE" "MAYBE" +pEITHER = pCostReserved 5 "EITHER" "EITHER" +pMAP = pCostReserved 5 "MAP" "MAP" +pINTMAP = pCostReserved 5 "INTMAP" "INTMAP" +pUSE = pCostReserved 5 "USE" "USE" +pLOC = pCostReserved 5 "loc" "loc" +pLHS = pCostReserved 5 "lhs" "loc" +pINST = pCostReserved 5 "inst" "inst" +pAt = pCostReserved 5 "@" "@" +pDot = pCostReserved 5 "." "." +pUScore = pCostReserved 5 "_" "_" +pColon = pCostReserved 5 ":" ":" +pDoubleColon = pCostReserved 5 "::" "::" +pEquals = pCostReserved 5 "=" "=" +pColonEquals = pCostReserved 5 ":=" ":=" +pTilde = pCostReserved 5 "~" "~" +pPlus = pCostReserved 5 "+" "+" +pBar = pCostReserved 5 "|" "|" +pIntersect = pCostReserved 5 "/\\" "/\\" +pMinus = pCostReserved 5 "-" "-" +pDoubleArrow = pCostReserved 5 "=>" "=>" +pArrow = pCostReserved 5 "->" "->" +pStar = pCostReserved 5 "*" "*" +pSmaller = pCostReserved 5 "<" "<" +pMODULE = pCostReserved 5 "MODULE" "MODULE" +pUNIQUEREF = pCostReserved 5 "UNIQUEREF" "UNIQUEREF" +pAUGMENT = pCostReserved 5 "AUGMENT" "AUGMENT" +pAROUND = pCostReserved 5 "AROUND" "AROUND" +pMERGE = pCostReserved 5 "MERGE" "MERGE" +pAS = pCostReserved 5 "AS" "AS" diff --git a/src/Pretty.hs b/src/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/Pretty.hs @@ -0,0 +1,176 @@ +------------------------------------------------------------------------- +-- Subset of UU.Pretty, based on very simple pretty printing +-- Extended with line-nr tracking +------------------------------------------------------------------------- + +module Pretty + ( PP_Doc, PP(..) + , disp + + , (>|<), (>-<) + , (>#<) + , ppWithLineNr + , hlist, vlist, hv + , fill + , indent + + , pp_block + , vlist_sep + , pp_parens + , pp_braces + , hv_sp + + , empty, text + ) + where + +import Data.List(intersperse) + +------------------------------------------------------------------------- +-- Doc structure +------------------------------------------------------------------------- + +data Doc + = Emp + | Str !String -- basic string + | Hor Doc !Doc -- horizontal positioning + | Ver Doc !Doc -- vertical positioning + | Ind !Int Doc -- indent + | Line (Int -> Doc) -- line nr + +type PP_Doc = Doc + +------------------------------------------------------------------------- +-- Basic combinators +------------------------------------------------------------------------- + +infixr 3 >|<, >#< +infixr 2 >-< + +(>|<) :: (PP a, PP b) => a -> b -> PP_Doc +l >|< r = pp l `Hor` pp r + +(>-<) :: (PP a, PP b) => a -> b -> PP_Doc +l >-< r = pp l `Ver` pp r + +(>#<) :: (PP a, PP b) => a -> b -> PP_Doc +l >#< r = l >|< " " >|< r + +indent :: PP a => Int -> a -> PP_Doc +indent i d = Ind i $ pp d + +text :: String -> PP_Doc +text s + = let ls = lines s + ls' | null ls = [""] + | otherwise = ls + in vlist (map Str ls') + +empty :: PP_Doc +empty = Emp + +ppWithLineNr :: PP a => (Int -> a) -> PP_Doc +ppWithLineNr f = Line (pp . f) + +------------------------------------------------------------------------- +-- Derived combinators +------------------------------------------------------------------------- + +hlist, vlist :: PP a => [a] -> PP_Doc +vlist [] = empty +vlist as = foldr (>-<) empty as +hlist [] = empty +hlist as = foldr (>|<) empty as + +hv :: PP a => [a] -> PP_Doc +hv = vlist + +hv_sp :: PP a => [a] -> PP_Doc +hv_sp = foldr (>#<) empty + +fill :: PP a => [a] -> PP_Doc +fill = hlist + +pp_block:: (PP a, PP b, PP c) => a -> b -> c -> [PP_Doc] -> PP_Doc +pp_block o c s as = pp o >|< hlist (intersperse (pp s) as) >|< pp c + +pp_parens :: PP a => a -> PP_Doc +pp_parens p = '(' >|< p >|< ')' + +pp_braces :: PP a => a -> PP_Doc +pp_braces p = '{' >-< p >-< '}' + +vlist_sep :: (PP a, PP b) => a -> [b] -> PP_Doc +vlist_sep sep lst + = vlist (intersperse (pp sep) (map pp lst)) + +------------------------------------------------------------------------- +-- PP class +------------------------------------------------------------------------- + +class Show a => PP a where + pp :: a -> PP_Doc + pp = text . show + + ppList :: [a] -> PP_Doc + ppList as = hlist as + +instance PP Doc where + pp = id + +instance PP Char where + pp c = text [c] + ppList = text + +instance PP a => PP [a] where + pp = ppList + +instance Show Doc where + show p = disp p 200 "" + +instance PP Int where + pp = text . show + +instance PP Float where + pp = text . show + +------------------------------------------------------------------------- +-- Observation +------------------------------------------------------------------------- + +isEmpty :: PP_Doc -> Bool +isEmpty Emp = True +isEmpty (Ver d1 d2) = isEmpty d1 && isEmpty d2 +isEmpty (Hor d1 d2) = isEmpty d1 && isEmpty d2 +isEmpty (Ind _ d ) = isEmpty d +isEmpty _ = False + +------------------------------------------------------------------------- +-- Rendering +------------------------------------------------------------------------- + +disp :: PP_Doc -> Int -> ShowS +disp d _ s + = r + where (r,_,_) = put 0 1 d s + put p l d s + = case d of + Emp -> (s,p,l) + Str s' -> (s' ++ s,p + length s',l) + Ind i d -> (ind ++ r,p', l') + where (r,p',l') = put (p+i) l d s + ind = replicate i ' ' + Hor d1 d2 -> (r1,p2,l2) + where (r1,p1,l1) = put p l d1 r2 + (r2,p2,l2) = put p1 l1 d2 s + Ver d1 d2 | isEmpty d1 + -> put p l d2 s + Ver d1 d2 | isEmpty d2 + -> put p l d1 s + Ver d1 d2 -> (r1,p2,l2) + where (r1,p1,l1) = put p l d1 $ "\n" ++ ind ++ r2 + (r2,p2,l2) = put p (l1+1) d2 s + ind = replicate p ' ' + Line f -> (r,p',l') + where (r,p',l') = put p l (f l) s + diff --git a/src/RhsCheck.hs b/src/RhsCheck.hs new file mode 100644 --- /dev/null +++ b/src/RhsCheck.hs @@ -0,0 +1,67 @@ +module RhsCheck(checkRhs,checkBlock,checkTy) where + +import Data.Maybe (fromMaybe) +import Language.Haskell.Exts +import ErrorMessages +import ConcreteSyntax +import Expression +import HsToken +import UU.Scanner.Position + +checkRhs,checkBlock,checkTy :: Expression -> Errors +checkRhs = check parseExpWithMode +checkBlock = check parseModuleWithMode +checkTy = check parseTypeWithMode + +check :: (ParseMode -> String -> ParseResult a) -> Expression -> Errors +check p (Expression pos tks) = case res of + ParseOk _ -> [] + ParseFailed loc msg -> let pos' = Pos (srcLine loc + line pos - 1) (srcColumn loc) (srcFilename loc) + in [HsParseError pos' msg] + where + pos0 = Pos (line pos) 1 (file pos) + str = toString pos0 tks + res = p mode str + bf = case baseFixities of + [] -> Nothing + xs -> Just xs + mode = defaultParseMode { parseFilename = file pos, ignoreLanguagePragmas = False, extensions = exts + , ignoreLinePragmas = False, fixities = bf } + +exts :: [Extension] +exts = glasgowExts + +toString :: Pos -> HsTokens -> String +toString _ [] = "" +toString cPos (tk:tks) = move ++ current ++ next + where + tkPos = getPos tk + move = addSpacing (line tkPos - line cPos) (column cPos) (column tkPos) + current = fmt tk + nPos = upd tkPos current + next = toString nPos tks + +getPos :: HsToken -> Pos +getPos (AGLocal _ pos _) = pos +getPos (AGField _ _ pos _) = pos +getPos (HsToken _ pos) = pos +getPos (CharToken _ pos) = pos +getPos (StrToken _ pos) = pos +getPos (Err _ pos) = pos + +fmt :: HsToken -> String +fmt (AGLocal var _ _) = "_" ++ show var +fmt (AGField field attr _ _) = "_" ++ show field ++ "_" ++ show attr +fmt (HsToken val _) = val +fmt (CharToken val _) = show val +fmt (StrToken val _) = show val +fmt (Err val _) = val + +upd :: Pos -> String -> Pos +upd p s = foldl adv p s + +addSpacing :: Int -> Int -> Int -> String +addSpacing l c1 c2 = replicate l '\n' ++ replicate c ' ' + where + c | l == 0 = c2 - c1 + | otherwise = c2 - 1 diff --git a/src/Scanner.hs b/src/Scanner.hs new file mode 100644 --- /dev/null +++ b/src/Scanner.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE MagicHash, + UnboxedTuples #-} +module Scanner where +import GHC.Prim +import TokenDef +import UU.Scanner.Position +import UU.Scanner.Token +import UU.Parsing(InputState(..),Either'(..)) +import Maybe +import List +import Char +import UU.Scanner.GenToken +import Options + +data Input = Input !Pos String (Maybe (Token, Input)) + +instance InputState Input Token Pos where + splitStateE input@(Input _ _ next) = + case next of + Nothing -> Right' input + Just (s, rest) -> Left' s rest + splitState (Input _ _ next) = + case next of + Nothing -> error "splitState on empty input" + Just (s, rest) -> (# s, rest #) + getPosition (Input pos _ next) = case next of + Just (s,_) -> position s + Nothing -> pos -- end of file + + +input :: Options -> Pos -> String -> Input +input opts pos inp = Input pos + inp + (case scan opts pos inp of + Nothing -> Nothing + Just (s,p,r) -> Just (s, input opts p r) + ) + +type Lexer s = Pos -> String -> Maybe (s,Pos,String) + +scan :: Options -> Lexer Token +scan opts + = scan + where + keywords' = if lcKeywords opts + then map (map toLower) keywords + else keywords + mkKeyword s | s `elem` lowercaseKeywords = s + | otherwise = map toUpper s + + scan :: Lexer Token + scan p [] = Nothing + scan p ('-':'-':xs) | null xs || not (head xs `elem` "<>!?#@:%$^&") + = let (com,rest) = span (/= '\n') xs + in advc' (2+length com) p scan rest + scan p ('{':'-':xs) = advc' 2 p (ncomment scan) xs + scan p ('{' :xs) = advc' 1 p codescrap xs + scan p ('\CR':xs) = case xs of + '\LF':ys -> newl' p scanBeginOfLine ys --ms newline + _ -> newl' p scanBeginOfLine xs --mac newline + scan p ('\LF':xs) = newl' p scanBeginOfLine xs --unix newline + scan p (x:xs) | isSpace x = updPos' x p scan xs + scan p xs = Just (scan' xs) + where scan' ('.' :rs) = (reserved "." p, advc 1 p, rs) + scan' ('@' :rs) = (reserved "@" p, advc 1 p, rs) + scan' (',' :rs) = (reserved "," p, advc 1 p, rs) + scan' ('_' :rs) = (reserved "_" p, advc 1 p, rs) + scan' ('~' :rs) = (reserved "~" p, advc 1 p, rs) + scan' ('+' :rs) = (reserved "+" p, advc 1 p, rs) + scan' ('<' :rs) = (reserved "<" p, advc 1 p, rs) + scan' ('[' :rs) = (reserved "[" p, advc 1 p, rs) + scan' (']' :rs) = (reserved "]" p, advc 1 p, rs) + scan' ('(' :rs) = (reserved "(" p, advc 1 p, rs) + scan' (')' :rs) = (reserved ")" p, advc 1 p, rs) + -- scan' ('{' :rs) = (OBrace p, advc 1 p, rs) + -- scan' ('}' :rs) = (CBrace p, advc 1 p, rs) + + scan' ('\"' :rs) = let isOk c = c /= '"' && c /= '\n' + (str,rest) = span isOk rs + in if null rest || head rest /= '"' + then (errToken "unterminated string literal" p + , advc (1+length str) p,rest) + else (valueToken TkString str p, advc (2+length str) p, tail rest) + + scan' ('=' : '>' : rs) = (reserved "=>" p, advc 2 p, rs) + scan' ('=' :rs) = (reserved "=" p, advc 1 p, rs) + scan' (':':'=':rs) = (reserved ":=" p, advc 2 p, rs) + + scan' (':':':':rs) {- | doubleColons opts -} = (reserved "::" p, advc 1 p, rs) -- recognize double colons too + scan' (':' :rs) = (reserved ":" p, advc 1 p, rs) + scan' ('|' :rs) = (reserved "|" p, advc 1 p, rs) + + scan' ('/':'\\':rs) = (reserved "/\\" p, advc 2 p, rs) + scan' ('-':'>' :rs) = (reserved "->" p, advc 2 p, rs) + scan' ('-' :rs) = (reserved "-" p, advc 1 p, rs) + scan' ('*' :rs) = (reserved "*" p, advc 1 p, rs) + + scan' (x:rs) | isLower x = let (var,rest) = ident rs + str = (x:var) + tok | str `elem` keywords' = reserved (mkKeyword str) + | otherwise = valueToken TkVarid str + in (tok p, advc (length var+1) p, rest) + | isUpper x = let (var,rest) = ident rs + str = (x:var) + tok | str `elem` keywords' = reserved (mkKeyword str) + | otherwise = valueToken TkConid str + in (tok p, advc (length var+1) p,rest) + | otherwise = (errToken ("unexpected character " ++ show x) p, advc 1 p, rs) + + scanBeginOfLine :: Lexer Token + scanBeginOfLine p ('{' : '-' : ' ' : 'L' : 'I' : 'N' : 'E' : ' ' : xs) + | isOkBegin rs && isOkEnd rs' + = scan (advc (8 + length r + 2 + length s + 4) p') (drop 4 rs') + | otherwise + = Just (errToken ("Invalid LINE pragma: " ++ show r) p, advc 8 p, xs) + where + (r,rs) = span isDigit xs + (s, rs') = span (/= '"') (drop 2 rs) + p' = Pos (read r - 1) (column p) s -- LINE pragma indicates the line number of the /next/ line! + + isOkBegin (' ' : '"' : _) = True + isOkBegin _ = False + + isOkEnd ('"' : ' ' : '-' : '}' : _) = True + isOkEnd _ = False + scanBeginOfLine p xs + = scan p xs + + +ident = span isValid + where isValid x = isAlphaNum x || x =='_' || x == '\'' +lowercaseKeywords = ["loc","lhs", "inst"] +keywords = lowercaseKeywords ++ + [ "DATA", "EXT", "ATTR", "SEM","TYPE", "USE", "INCLUDE" + , "SET","DERIVING","FOR", "WRAPPER", "NOCATAS", "MAYBE", "EITHER", "MAP", "INTMAP" + , "PRAGMA", "SEMPRAGMA", "MODULE", "ATTACH", "UNIQUEREF", "INH", "SYN", "CHN" + , "AUGMENT", "AROUND", "MERGE", "AS" + ] + +ncomment c p ('-':'}':xs) = advc' 2 p c xs +ncomment c p ('{':'-':xs) = advc' 2 p (ncomment (ncomment c)) xs +ncomment c p (x:xs) = updPos' x p (ncomment c) xs +ncomment c p [] = Just (errToken "unterminated nested comment" p, p,[]) + +codescrap p xs = let (p2,xs2,sc) = codescrap' 1 p xs + in case xs2 of + ('}':rest) -> Just (valueToken TkTextln sc p,advc 1 p2,rest) + _ -> Just (errToken "unterminated codescrap" p,p2,xs2) + + +codescrap' d p [] = (p,[],[]) +{- +codescrap' d p ('{':'{':xs) = let (p2,xs2,sc) = advc' 2 p (codescrap' d) xs + in (p2,xs2,'{':' ':sc) +codescrap' d p ('}':'}':xs) = let (p2,xs2,sc) = advc' 2 p (codescrap' d) xs + in (p2,xs2,'}':' ':sc) +-} +codescrap' d p ('{':xs) = let (p2,xs2,sc) = advc' 1 p (codescrap' (d+1)) xs + in (p2,xs2,'{' : sc) +codescrap' d p ('}':xs) | d == 1 = (p,'}':xs,[]) + | otherwise = let (p2,xs2,sc) = advc' 1 p (codescrap' (d-1)) xs + in (p2,xs2,'}' : sc) +codescrap' d p (x :xs) = let (p2,xs2,sc) = updPos' x p (codescrap' d) xs + in (p2,xs2,x:sc) +--Literate Mode +scanLit xs = (fs, foldr insNL (const "") codeLns 1) + where insNL (n,line) r = \n1 -> replicate (n-n1) '\n' ++ line ++ r n + (fs,codeLns,_) = getBlocks ([1..] `zip` toLines xs) + getBlocks [] = ([],[],[]) + getBlocks xs = let (files1,txt1,r1) = getBlock xs + (files2,txt2,r2) = getBlocks r1 + in (files1++files2, txt1++txt2, r2) + + + getBlock = getLines . dropWhile comment + getLines [] = ([],[],[]) + getLines ((n,l):ls) | "\\begin{code}" `isPrefixOf` l = let (lns,rest) = codelines ls + in ([],lns,rest) + | "\\begin{Code}" `isPrefixOf` l = let (lns,rest) = codeLines ls + in ([],lns,rest) + | "\\IN{" `isPrefixOf` l = + let name = getName l + in ([name],[],ls) + | otherwise = getBlock ls + comment = not . ("\\" `isPrefixOf`) .snd + +toLines :: String -> [String] +toLines "" = [] +toLines s = let (l,s') = breakLine s + in l : toLines s' +breakLine xs = case xs of + '\CR' : ys -> case ys of + '\LF' : zs -> ([],zs) + _ -> ([],ys) + '\LF' : ys -> ([], ys) + x : ys -> let (l,s) = breakLine ys + in (x:l,s) + [] -> ([],[]) + +codelines [] = error "Unterminated literate code block" +codelines ((n,l):ls) | "\\end{code}" `isPrefixOf` l = ([],ls) + | otherwise = let (lns,r) = codelines ls + in ((n,l):lns,r) + +codeLines [] = error "Unterminated literate Code block" +codeLines ((n,l):ls) | "\\end{Code}" `isPrefixOf` l = ([],ls) + | otherwise = let (lns,r) = codeLines ls + in ((n,l):lns,r) + +getName l = case r of + ('}':_) -> nm + _ -> error $ "missing '}' in \\IN" + where (nm,r) = span (/='}') (drop 4 l) diff --git a/src/SequentialComputation.lhs b/src/SequentialComputation.lhs new file mode 100644 --- /dev/null +++ b/src/SequentialComputation.lhs @@ -0,0 +1,394 @@ +\begin{code} +module SequentialComputation (computeSequential,Vertex,Edge,Table) where +import SequentialTypes +import CommonTypes +import Interfaces +import InterfacesRules +import CodeSyntax +import GrammarInfo + +import Debug.Trace +import Control.Monad(liftM,when,unless) +import Control.Monad.ST(ST, runST) +import Data.Array(Array,(!),bounds,elems) +import Data.Array.ST(STArray, newArray, readArray, writeArray, freeze) +import Data.Maybe(listToMaybe,mapMaybe,isJust,fromJust) +import Data.List(partition,nub,(\\),delete,minimumBy) +import qualified Data.Set as Set +import qualified Data.Map as Map + +\end{code} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Collecting information} + +In the Data.Graph library, +a graph is represented as |Array Vertex [Vertex]|, +mapping each vertex to a list of adjacent vertices. +A |Vertex| is simply encoded by an |Int|. +So to test whether an edge |(x,y)| belongs to |g| +we can evaluate |y `elem` g!x| + +For more efficiency, we use Maps instead of lists. +Sets would also have done, but we also want to each edge to have a path as a witness. + +Moreover, as we will mostly be adding edges to the graph, +we use a mutable array. +If we want to use any of the library +functions, we can convert our representation by |fmap Map.keys . freeze|. + +\begin{code} +type Graph = Array Vertex [Vertex] +type MGraph = Array Vertex (Map.Map Vertex Path) +type MMGraph s = STArray s Vertex (Map.Map Vertex Path) + +singleStep :: (Vertex->Vertex->PathStep) -> Edge -> EdgePath +singleStep f e@(s,t) = (e, [f s t]) + +\end{code} + +We can add an edge to a graph, or remove it. These functions return +whether they did something (resp. addition or removal) or not. hasEdge +only checks whether a graph contains an edge or not. + +\begin{code} +addEdge :: MMGraph s -> EdgePath -> ST s Bool +addEdge graph ((s,t),p) + = do m <- readArray graph s + let b = not (Map.member t m) + when b (writeArray graph s (Map.insert t p m)) + return b + +hasEdge :: MMGraph s -> EdgePath -> ST s Bool +hasEdge graph ((s,t),_) + = do m <- readArray graph s + return (Map.member t m) +\end{code} + +The first step is to assign a number to all attributes, and a +different one to all attribute occurrences. We create an array mapping +the numbers to the information about the attribute occurrences +(|ruleTable|), so we can look up this information in $O(1)$ time. We +also build mappings from attributes to their occurrences (|tdsToTdp|) +and vice versa (|tdpToTds|). |LMH| indicates the division of the +attributes - an element |(l,m,h) `elem` LMH| means that vertices |i, l +<= i <= h| are attributes of the same nonterminal, with vertices |j, l +<= j < m| being inherited and |k, m <= k <= h| being synthesized +attributes. + +See the |SequentialTypes.Info| and |SequentialTypes.LMH| + +Then we collect the direct dependencies, using the integer +representations. This list of tuples (edges in the dependency graph) +all information that is collected is passed to a function that will +compute the interfaces and visit sub-sequences. We cannot do this +computation in AG, because mutable arrays require the ST monad, which +cannot be used inside AG. + +Now we can build a graph for attributes, and a graph for ao's, and add +the direct dependencies to the ao graph. Like Pennings we will call +the attribte graph Tds (transitive dependencies of symbols), and the +ao-graph Tdp (transitive dependencies of productions). Unlike him, we +will have only one Tds and one Tdp graph. In |STGraph|, we can lookup +outgoing edges in |O(1)| time, but looking up incoming edges will take +|O(e)| time, where |e| is the number of edges in the graph. As we will +be doing this quite often it is worthwhile to keep both Tdp and its +transposed version. The computation will involve both Tds and Tdp. It +treats specially. TODO elaborate on that. + +\begin{code} +type Tdp s = (MMGraph s, MMGraph s) +type Tds s = MMGraph s +type Comp s = (Tds s, Tdp s) +\end{code} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Generating IDS} + +As we insert edges into Tdp we keep it transitively closed, so every +time we add the edge $(s,t)$ to V, we also add the edges +$\{ (r,t) || (r,s) \in V \}$ and +$\{ (s,u) || (t,u) \in V \}$. + +\begin{code} +insertTdp :: Info -> Comp s -> EdgePath -> ST s () +insertTdp info comp@(_,(tdpN,tdpT)) e@((s,t),ee) -- how to insert an edge (s,t): + = do b <- hasEdge tdpN e -- if it's not yet present + unless b + (do rs <- readArray tdpT s -- find all sources r for an edge to s + us <- readArray tdpN t -- find all targets u for an edge from t + let edges = e :[ ((r,t),er++ee ) | (r,er) <- Map.toList rs ] + ++ [ ((s,u), ee++eu) | (u,eu) <- Map.toList us ] + ++ [ ((r,u),er++ee++eu) | (r,er) <- Map.toList rs, (u,eu) <- Map.toList us ] + mapM_ (addTdpEdge info comp) edges -- and add all of them, without having to bother about transitive closure anymore + ) +\end{code} + +Edges in |Tdp| can induce edges in |Tds|, so whenever we add +an edge, we also add the induced edge if necessary + +\begin{code} +addTdpEdge :: Info -> Comp s -> EdgePath -> ST s () -- how to add an edge (s,t) when not having to bother about the transitive closure: +addTdpEdge info comp@(_,(tdpN,tdpT)) e@((s,t),ee) + = do b <- addEdge tdpN e -- add it to the normal graph + when b -- if it was a new edge + (do addEdge tdpT ((t,s),ee) -- also add it to the transposed graph + let u = tdpToTds info ! s -- find the corresponding attributes... + v = tdpToTds info ! t + nonlocal = u /= -1 && v /= -1 + equalfield = isEqualField (ruleTable info ! s) (ruleTable info ! t) + when (nonlocal && equalfield) -- ...and when necessary... + (insertTds info comp ((u,v),ee)) -- ...insert it to the Tds graph + ) +\end{code} + +Inserting edges into |Tds| will insert edges between the occurrences +of the attributes into |Tdp|. + +\begin{code} +insertTds :: Info -> Comp s -> EdgePath -> ST s () +insertTds info comp@(tds,_) e@((u,v),ee) + = do b <- addEdge tds e + when b + (mapM_ (insertTdp info comp) [ ( (s,t), [AttrStep u v] ) + | s <- tdsToTdp info ! u + , not (getIsIn (ruleTable info ! s)) -- inherited at LHS, or synthesized at RHS + , t <- tdsToTdp info ! v + , getIsIn (ruleTable info ! t) -- synthesized at LHS, or inherited at RHS + , isEqualField (ruleTable info ! s) (ruleTable info ! t) + ] + ) + +\end{code} + +If we add the direct dependencies to the Tdp graph in the way above, the +Tds graph is filled with IDS. +Below is a way to only build up the Tdp graph, without reflect the changes in the Tds graph. + +\begin{code} +simpleInsert :: Tdp s -> EdgePath -> ST s () +simpleInsert tdp@(tdpN,tdpT) e@((s,t),ee) + = do b <- hasEdge tdpT ((t,s),undefined) + unless b (do rs <- readArray tdpT s + us <- readArray tdpN t + let edges = e :[ ((r,t),er++ee ) | (r,er) <- Map.toList rs ] + ++ [ ((s,u), ee++eu) | (u,eu) <- Map.toList us ] + ++ [ ((r,u),er++ee++eu) | (r,er) <- Map.toList rs, (u,eu) <- Map.toList us ] + mapM_ (addSimpleEdge tdp) edges + ) + +addSimpleEdge :: Tdp s -> EdgePath -> ST s () +addSimpleEdge (tdpN,tdpT) e@((s,t),ee) + = do b <- addEdge tdpN e + when b (do addEdge tdpT ((t,s),ee) + return () + ) +\end{code} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Interfaces} + +In absence of cycles we can find the interfaces. We only take +attributes that are used. + +When an attribute has no incoming edges it can be computed. As the +emphasis is on incoming edges, we will work with the transposed Tds +graph. The funtion |used| indicates which vertices are included in the +interfaces. + +See modules Interfaces and InterfacesRules for more information. + +%format sem_IRoot_IRoot = "sem_{IRoot}" +%format sem_Interface_Interface = "sem_{Interface}" +%format sem_Interfaces_Cons = ":_{Interfaces}" +%format sem_Interfaces_Nil = "[]_{Interfaces}" +%format sem_Segments_Cons = ":_{Segments}" +%format sem_Segments_Nil = "[]_{Segments}" + +\begin{code} +makeInterfaces :: Info -> Graph -> T_IRoot +makeInterfaces info tds + = let interslist = reverse . makeInterface tds [] + mkSegments = foldr (sem_Segments_Cons . uncurry sem_Segment_Segment) sem_Segments_Nil . interslist + mkInter ((nt,cons),lmh) = sem_Interface_Interface nt cons (mkSegments lmh) + inters = foldr (sem_Interfaces_Cons . mkInter) sem_Interfaces_Nil (zip (nonts info) (lmh info)) + in sem_IRoot_IRoot inters +\end{code} + +The sinks of a graph are those vertices that have no outgoing +edges. We define a function that determines whether a vertex is a sink +if a set |del| of vertices had been removed from the graph. This means +that the attribute can be computed if all attributes in |del| have +been computed. + +\begin{code} +isSink :: Graph -> [Vertex] -> Vertex -> Bool +isSink graph del v = null (graph ! v \\ del) +\end{code} + +Now we can make interfaces by taking inherited sinks and synthesized +sinks alternatively. If there are no synthesized attributes at all, +generate an interface with one visit computing nothing. + +\begin{code} +makeInterface :: Graph -> [Vertex] -> LMH -> [([Vertex],[Vertex])] +makeInterface tds del (l,m,h) + | m > h = [([],[])] + | otherwise = let syn = filter (isSink tds del) ([m..h] \\ del) + del' = del ++ syn + inh = filter (isSink tds del') ([l..(m-1)] \\ del') + del'' = del' ++ inh + rest = makeInterface tds del'' (l,m,h) + in if null inh && null syn + then [] + else (inh,syn) : rest +\end{code} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Detecting of cycles} + +We only want to return s2i edges. + +\begin{code} +findCycles :: Info -> MGraph -> [EdgePaths] +findCycles info tds + = [ ((u,v),p1,p2) + | (l,m,h) <- lmh info -- for every nonterminal: [l..m-1] are inherited, [m..h] are synthesized + , v <- [m..h] -- for every synthesized attribute + , (u,p1) <- Map.toList (tds ! v) -- find dependent attributes... + , l <= u, u < m -- ...that are inherited... + , let mbp2 = Map.lookup v (tds ! u) -- ...and have a cycle back + , isJust mbp2 + , let p2 = fromJust mbp2 + ] + +findLocCycles :: MGraph -> [EdgePath] +findLocCycles tdp + = let (low, high) = bounds tdp + in [ ((u,u),p) + | u <- [low..high] + , (v,p) <- Map.toList (tdp ! u) + , v==u + ] + +findInstCycles :: [Edge] -> MGraph -> [EdgePath] +findInstCycles instToSynEdges tdp + = [ ((i,s), fromJust mbp) + | (i, s) <- instToSynEdges + , let mbp = Map.lookup i (tdp ! s) + , isJust mbp + ] +\end{code} + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Tying it together} + +\begin{code} +generateVisits :: Info -> MGraph -> MGraph -> [Edge] -> (CInterfaceMap, CVisitsMap, [Edge]) +generateVisits info tds tdp dpr + = let inters = makeInterfaces info (fmap Map.keys tds) + inhs = Inh_IRoot{ info_Inh_IRoot = info + , tdp_Inh_IRoot = fmap Map.keys tdp + , dpr_Inh_IRoot = dpr + } + iroot = wrap_IRoot inters inhs + in (inters_Syn_IRoot iroot, visits_Syn_IRoot iroot, edp_Syn_IRoot iroot) + +reportLocalCycle :: MGraph -> [EdgePath] -> [[Vertex]] +reportLocalCycle tds cyc + = fst (foldr f ([],Set.empty) (map (edgePathToEdgeRoute tds) cyc)) + where f ((x,_),p) res@(paths,syms) | Set.member x syms = res -- don't report a cyclic vertex if it appears on a path of an earlier reported one + | otherwise = (p:paths, Set.union syms (Set.fromList p)) + +reportCycle :: Info -> MGraph -> [EdgePaths] -> [EdgeRoutes] +reportCycle info tds cyc + = fst (foldr f ([],Set.empty) (map (edgePathsToEdgeRoutes tds) cyc)) + where f epp@((x,y),p1,p2) res@(paths,syms) | Set.member x syms && + Set.member y syms = res -- don't report mutually dependent vertices if both appear on paths reported earlier + | otherwise = (epp:paths, Set.union syms (Set.fromList (map tdp2tds (p1++p2)))) + tdp2tds (-2) = -2 + tdp2tds v = tdpToTds info ! v + +edgePathsToEdgeRoutes :: MGraph -> EdgePaths -> EdgeRoutes +edgePathsToEdgeRoutes tds (e,p1,p2) = ( e, pathToRoute tds p1, pathToRoute tds p2 ) + +edgePathToEdgeRoute :: MGraph -> EdgePath -> EdgeRoute +edgePathToEdgeRoute tds (e,p) = ( e, pathToRoute tds p ) + +pathToRoute :: MGraph -> Path -> Route +pathToRoute tds p = convertPath (expandAll p) + where expandAll :: Path -> Path + expandAll p | hasAttrStep p = expandAll (expandOne p) + | otherwise = p + expandOne :: Path -> Path + expandOne p = shortcut (concatMap expandStep p) + expandStep :: PathStep -> Path + expandStep (AttrStep u v) = fromJust (Map.lookup v (tds!u)) + expandStep x = [x] + convertPath :: Path -> Route + convertPath p = concatMap convertStep p + convertStep :: PathStep -> Route + convertStep (AtOcStep s t) = [s,t] + convertStep (AttrIndu s t) = [-2,-2] + +hasAttrStep :: Path -> Bool +hasAttrStep [] = False +hasAttrStep (AttrStep _ _ : _ ) = True +hasAttrStep (_ : xs) = hasAttrStep xs + +shortcut :: Eq a => [a] -> [a] +shortcut [] = [] +shortcut (x:xs) = x : shortcut (removeBefore x xs) + +removeBefore :: Eq a => a -> [a] -> [a] +removeBefore x ys = reverse (takeWhile (/=x) (reverse ys)) + + +isLocLoc :: Table CRule -> EdgePath -> Bool +isLocLoc rt ((s,t),_) = isLocal (rt ! s) && isLocal (rt ! t) + -- || (isInst (rt ! s) && isInst (rt ! t)) + +computeSequential :: Info -> [Edge] -> [Edge] -> CycleStatus +computeSequential info dpr instToSynEdges + = runST + (do let bigBounds = bounds (tdpToTds info) + smallBounds = bounds (tdsToTdp info) + (ll,es) = partition (isLocLoc (ruleTable info)) (map (singleStep AtOcStep) (dpr ++ instToSynEdges)) + tds <- newArray smallBounds Map.empty + tdpN <- newArray bigBounds Map.empty + tdpT <- newArray bigBounds Map.empty + let tdp = (tdpN,tdpT) + comp = (tds,tdp) + mapM_ (simpleInsert tdp) ll -- insert the local dependencies + tdp1 <- freeze tdpN + let cyc1 = findLocCycles tdp1 + if not (null cyc1) -- are they cyclic? + then do return (LocalCycle (reportLocalCycle undefined cyc1)) -- then report an error. + else do mapM_ (insertTdp info comp) es -- insert the other dependencies + tds2 <- freeze tds + let cyc2 = findCycles info tds2 + if not (null cyc2) -- are they cyclic? + then do return (DirectCycle (reportCycle info tds2 cyc2)) -- then report an error. + else do tdp2 <- freeze tdpN + let cyc4 = findInstCycles instToSynEdges tdp2 + if not (null cyc4) + then do return (InstCycle (reportLocalCycle tds2 cyc4)) -- then report an error. + else do let (cim,cvm,edp) = generateVisits info tds2 tdp2 dpr + mapM_ (insertTds info comp) (map (singleStep AttrIndu) edp) -- insert dependencies induced by visit scheduling + tds3 <- freeze tds + let cyc3 = findCycles info tds3 + if not (null cyc3) -- are they cyclic? + then return (InducedCycle cim (reportCycle info tds3 cyc3)) -- then report an error. + else do tdp3 <- freeze tdpN + let cyc5 = findInstCycles instToSynEdges tdp3 + if not (null cyc5) + then do return (InstCycle (reportLocalCycle tds3 cyc5)) -- then report an error. + else do return (CycleFree cim cvm) -- otherwise we succeed. + ) +\end{code} + + +\end{document} diff --git a/src/SequentialTypes.hs b/src/SequentialTypes.hs new file mode 100644 --- /dev/null +++ b/src/SequentialTypes.hs @@ -0,0 +1,138 @@ +module SequentialTypes where + +import CodeSyntax +import CommonTypes +import Data.Array(Array) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Maybe(fromJust) +import Data.List(partition) +import UU.Pretty + + +type Vertex = Int +data PathStep = AttrStep Vertex Vertex + | AtOcStep Vertex Vertex + | AttrIndu Vertex Vertex + deriving (Show, Eq) + +type Path = [PathStep] +type Route = [Vertex] + +type Edge = (Int,Int) +type EdgePath = (Edge,Path) +type EdgePaths = (Edge,Path,Path) +type EdgeRoute = (Edge,Route) +type EdgeRoutes= (Edge,Route,Route) + +type Table a = Array Vertex a + + +data ChildVisit = ChildVisit Identifier Identifier Int [Vertex] [Vertex] deriving (Eq,Show) -- field, rhs nt, visit nr., inh, syn +data NTAttr = NTAInh NontermIdent Identifier Type -- nt, attribute, type + | NTASyn NontermIdent Identifier Type -- nt, attribute, type + deriving Show + +getNtaNameType (NTAInh nt name tp) = (name,tp) +getNtaNameType (NTASyn nt name tp) = (name,tp) + +getAttr (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = name +getIsIn (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = ii +getHasCode (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = hc +getLhsNt (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = nt +getCon (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = con +getField (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = field +getRhsNt (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = childnt +getType (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = tp +getDefines (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = defines +getUses (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = uses +getExplicit (CRule name ii hc nt con field childnt tp pattern rhs defines owrt origin uses expl _) = expl + +isLocal = (_LOC==) . getField +isInst = (_INST==) . getField +isLhs = (_LHS==) . getField +isRhs cr = not (isLhs cr || isLocal cr) +isSyn cr | isLocal cr = False + | getIsIn cr = isRhs cr + | otherwise = isLhs cr +isInh = not . isSyn +hasCode cr = isLocal cr || (isLhs cr && isInh cr) || (isRhs cr && isSyn cr) + +isEqualField a b = isEqualCon a b && getField a == getField b +isDifferentField a b = isEqualCon a b && getField a /= getField b +isEqualCon a b = getLhsNt a == getLhsNt b && getCon a == getCon b +isRhsOfSameCon a b = isEqualCon a b && isRhs a && isRhs b + +isSynAttr (NTAInh _ _ _) = False +isSynAttr (NTASyn _ _ _) = True +isInhAttr = not . isSynAttr + +ntattr :: CRule -> Maybe NTAttr +ntattr cr | isLocal cr = Nothing + | isInst cr = Nothing -- an inst definition is just considered as a local attribute definition + | otherwise = let at = if isSyn cr then NTASyn else NTAInh + getNt cr = if isRhs cr then fromJust (getRhsNt cr) else getLhsNt cr + in Just (at (getNt cr) (getAttr cr) (fromJust (getType cr))) + +cRuleLhsInh :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> CRule +cRuleLhsInh attr nt con tp = CRule attr True False nt con _LHS Nothing (Just tp) (error "cRuleLhsInh") [] Map.empty False "" Set.empty False Nothing +cRuleTerminal :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> CRule +cRuleTerminal attr nt con tp = CRule attr True False nt con _LOC Nothing (Just tp) (error ("cRuleTerminal: " ++ show (attr, nt, con, tp))) [] Map.empty False "" Set.empty False Nothing +cRuleRhsSyn :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> Identifier -> NontermIdent -> CRule +cRuleRhsSyn attr nt con tp field childnt = CRule attr True False nt con field (Just childnt) (Just tp) (error ("cRuleRhsSyn: " ++ show (attr, nt, con, tp, field))) [] Map.empty False "" Set.empty False Nothing + +defaultRule :: Identifier -> NontermIdent -> ConstructorIdent -> Identifier -> CRule +defaultRule attr nt con field = CRule attr (er 1) (er 2) nt con field (er 3) (er 4) (er 5) (er 6) (er 7) (er 8) (er 9) (er 10) False Nothing + where er i = error ("Default rule has no code " ++ show i) + +instance Eq CRule where + a == b = getAttr a == getAttr b && isEqualField a b +instance Ord CRule where + compare a b = compare (getLhsNt a) (getLhsNt b) + >/< compare (getCon a) (getCon b) + >/< compare (getField a) (getField b) + >/< compare (getAttr a) (getAttr b) +instance Eq NTAttr where + (NTAInh nt name _) == (NTASyn nt' name' _) = False + (NTASyn nt name _) == (NTAInh nt' name' _) = False + (NTAInh nt name _) == (NTAInh nt' name' _) = nt == nt' && name == name' + (NTASyn nt name _) == (NTASyn nt' name' _) = nt == nt' && name == name' +instance Ord NTAttr where + compare (NTAInh _ _ _) (NTASyn _ _ _) = LT + compare (NTASyn _ _ _) (NTAInh _ _ _) = GT + compare (NTAInh nt name _) (NTAInh nt' name' _) = compare nt nt' >/< compare name name' + compare (NTASyn nt name _) (NTASyn nt' name' _) = compare nt nt' >/< compare name name' + +eqCRuleDefines :: CRule -> CRule -> Bool +eqCRuleDefines a b + = Map.keys (getDefines a) == Map.keys (getDefines b) + +(>/<) :: Ordering -> Ordering -> Ordering +EQ >/< b = b +a >/< _ = a + + +eqClasses :: (a -> a -> Bool) -> [a] -> [[a]] +eqClasses p [] = [] +eqClasses p (a:as) = let (isA,rest) = partition (p a) as + in (a:isA):eqClasses p rest + +lhsshow (NTAInh field attr _) = lhsname True attr +lhsshow (NTASyn field attr _) = lhsname False attr + +rhsshow :: Identifier -> NTAttr -> String +rhsshow field (NTAInh _ attr _) = attrname False field attr +rhsshow field (NTASyn _ attr _) = attrname True field attr + +prettyCRule :: CRule -> String +prettyCRule cr + = let descr | isLocal cr = "local attribute " ++ show (getAttr cr) + | otherwise = (if isSyn cr then "synthesized " else "inherited ") + ++ "attribute " + ++ (if isRhs cr then show (getField cr) ++ "." else "") + ++ (if isLhs cr then "lhs." else "") + ++ (show (getAttr cr)) + in show (getLhsNt cr) ++ "." ++ show (getCon cr) ++ ", " ++ descr + diff --git a/src/Streaming.hs b/src/Streaming.hs new file mode 100644 --- /dev/null +++ b/src/Streaming.hs @@ -0,0 +1,107 @@ +module Streaming where + +import CommonTypes(Name) +import DepTypes +import List(partition) +import Maybe(fromMaybe,fromJust) + +mapp :: (a -> b) -> (a,a) -> (b,b) +mapp f (l,r) = (f l,f r) + +-- vervangt nub, bepaald wel de nub maar accumuleert tevens de causes +reduce :: [UsedAttr] -> [UsedAttr] +reduce set = red set [] where + red (res:rest) set' = red rest (r res set') + red [] set' = set' + r res [] = [res] + r (r1@(Loc f1 a1 c1)) ((r2@(Loc f2 a2 c2)):rest) = if f1==f2 && a1==a2 + then if length c1 < length c2 + then (Loc f2 a2 c1):rest + else r2:rest + else r2:(r r1 rest) + r (r1@(Glo a1 c1)) ((r2@(Glo a2 c2)):rest) = if a1==a2 + then if length c1 < length c2 + then (Glo a2 c1):rest + else r2:rest + else r2:(r r1 rest) + r (r1@(Loc f1 a1 c1)) ((r2@(Glo a2 c2)):rest) = r2:(r r1 rest) + r (r1@(Glo a1 c1)) ((r2@(Loc f2 a2 c2)):rest) = r2:(r r1 rest) + +-- NB: de rechter (update-) zijde van een streamelement is nooit bevat in de linker (set-) zijde!! +-- nieuwe update set (nu) is de concat van linker en rechter (lu & ru), maar met de al gevonden resultaten (ls' & rs') eruit gefilterd (lu' & ru'). +-- deze al gevonden resultaten kunnen onbekende causes bevatten, zijn worden daarom meegenomen in de reductie van de al gevonden resltaten (ls & rs). +-- deze resultaten zijn dus 100% zeker dubbel, maar worden meegenomen voor bepaling van de causes in het nieuwe resultaat +stUnion :: Stream -> Stream -> Stream +stUnion [] _ = [] +stUnion _ [] = [] +stUnion ((ls,lu):lr) ((rs,ru):rr) = (ns,nu):nr where + (lu',ls') = partition (flip notElem rs) lu + (ru',rs') = partition (flip notElem ls) ru + nu = lu' ++ ru' + ns = reduce (ls++ls'++rs++rs') + nr = stUnion lr rr + +{- +-- oude versie, met nub ipv reduce +stUnion :: Stream -> Stream -> Stream +stUnion [] _ = [] +stUnion _ [] = [] +stUnion ((xset,xupd):xrest) ((yset,yupd):yrest) = (nub (xset++yset),new):(stUnion xrest yrest) where + new = (filter (flip notElem yset) xupd) ++ (filter (flip notElem xset) yupd) +-} + +{- +-- de x wordt gebruikt om te kijken of de poort open staat, de y wordt doorgegeven als de poort openstaat +-- ouder versie, zonder kortste cause +stPort :: Name -> Stream -> Stream -> Stream +stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of + Just causes -> addTrace causes (([],yset++yupd):yrest) + Nothing -> ([],[]):(stPort attr xrest yrest) +-} +-- de x wordt gebruikt om te kijken of de poort open staat, de y wordt doorgegeven als de poort openstaat +-- de recursieve aanroep van stPortRest wordt gedaan om in het uiteindelijke resultaat de kortste cause te krijgen +-- waarom de cause niet initiëel de kortste is, weet ik niet. Maar er worden wel kortere causes gevonden later in het proces +{- +stPort :: Name -> Stream -> Stream -> Stream +stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of + Just causes -> (addTrace causes ([],yset++yupd)):(stPortRest attr xrest yrest) + Nothing -> ([],[]):(stPort attr xrest yrest) + where + stPortRest attr ((xset,xupd):xrest) (y:yrest) = case lookup attr (map toPair xset) of + Just causes -> (addTrace causes y):(stPortRest attr xrest yrest) + Nothing -> (error "Dit mag nooit gebeuren!" ([],[])):(stPortRest attr xrest yrest) +-} + + +-- 20 januari: herschrijving van bovenstaande versie in 1 functie (zonder where)... +stPort :: Name -> Stream -> Stream -> Stream +stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of + Just causes -> (addTrace causes ([],yset++yupd)):(zipWith (\(xset,xupd) y -> addTrace (fromJust . lookup attr . map toPair $ xset) y) xrest yrest) + Nothing -> ([],[]):(stPort attr xrest yrest) + +-- stStart biedt geen functionaliteit voor een initiële cause, want er zijn geen initiële causes: +-- het begin van een stream is namelijk altijd een attribuut dat zichzelf bepaalt. Dat heeft geen oorzaak nodig. +stStart :: Name -> Name -> Stream +stStart field attr = first:(repeat other) where + first = ([],[Loc field attr []]) + other = ([Loc field attr []],[]) + +stEmpty :: Stream +stEmpty = repeat ([],[]) + +getStream :: Vertex -> [UseStream] -> Stream +getStream vertex streams = fromMaybe stEmpty (lookup vertex streams) + +stLocal2global :: Stream -> Stream +stLocal2global = map (mapp (map (\res -> Glo (getAttr res) (getTrace res)))) +-- de nub hoeft niet, want het filter op fieldname van een lokaal resultaat filtert doublures er al uit +--stLocal2global = map (mapp (nub . (map (\res -> Glo (getAttr res))))) + +stFilterInclSide :: UseStream -> Stream +stFilterInclSide (vertex,stream) = stFilterOnField ((getField vertex)==) stream + +stFilterExclSide :: UseStream -> Stream +stFilterExclSide (vertex,stream) = stFilterOnField ((getField vertex)/=) stream + +stFilterOnField :: (Name -> Bool) -> Stream -> Stream +stFilterOnField f = map (mapp (filter (f . getField))) diff --git a/src/TokenDef.hs b/src/TokenDef.hs new file mode 100644 --- /dev/null +++ b/src/TokenDef.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE MagicHash, + UnboxedTuples #-} + +module TokenDef where + +import GHC.Prim +import UU.Scanner.Token +import UU.Scanner.GenToken +import UU.Scanner.GenTokenOrd +import UU.Scanner.Position +import UU.Parsing.MachineInterface(Symbol(..)) +import Char(isPrint,ord) +import HsToken +import CommonTypes + + + +instance Symbol Token where + deleteCost (Reserved key _) = case key of + "DATA" -> 7# + "EXT" -> 7# + "ATTR" -> 7# + "SEM" -> 7# + "USE" -> 7# + "INCLUDE" -> 7# + _ -> 5# + deleteCost (ValToken v _ _) = case v of + TkError -> 0# + _ -> 5# + + +tokensToStrings :: [HsToken] -> [(Pos,String)] +tokensToStrings + = map tokenToString + +tokenToString :: HsToken -> (Pos, String) +tokenToString tk + = case tk of + AGLocal var pos _ -> (pos, "@" ++ getName var) + AGField field attr pos _ -> (pos, "@" ++ getName field ++ "." ++ getName attr) + HsToken value pos -> (pos, value) + CharToken value pos -> (pos, show value) + StrToken value pos -> (pos, show value) + Err mesg pos -> (pos, " ***" ++ mesg ++ "*** ") + +showTokens :: [(Pos,String)] -> [String] +showTokens [] = [] +showTokens xs = map showLine . shiftLeft . getLines $ xs + +getLines [] = [] +getLines ((p,t):xs) = let (txs,rest) = span sameLine xs + sameLine (q,_) = line p == line q + in ((p,t):txs) : getLines rest + +shiftLeft lns = let sh = let m = minimum . checkEmpty . filter (>=1) . map (column.fst.head) $ lns + checkEmpty [] = [1] + checkEmpty x = x + in if m >= 1 then m-1 else 0 + shift (p,t) = (if column p >= 1 then case p of (Pos l c f) -> Pos l (c - sh) f else p, t) + in map (map shift) lns + +showLine ts = let f (p,t) r = let ct = column p + in \c -> spaces (ct-c) ++ t ++ r (length t+ct) + spaces x | x < 0 = "" + | otherwise = replicate x ' ' + in foldr f (const "") ts 1 + + +showStrShort xs = "\"" ++ concatMap f xs ++ "\"" + where f '"' = "\\\"" + f x = showCharShort' x + +showCharShort '\'' = "'" ++ "\\'" ++ "'" +showCharShort c = "'" ++ showCharShort' c ++ "'" + +showCharShort' '\a' = "\\a" +showCharShort' '\b' = "\\b" +showCharShort' '\t' = "\\t" +showCharShort' '\n' = "\\n" +showCharShort' '\r' = "\\r" +showCharShort' '\f' = "\\f" +showCharShort' '\v' = "\\v" +showCharShort' '\\' = "\\\\" +showCharShort' x | isPrint x = [x] + | otherwise = '\\' : show (ord x) + diff --git a/src/Version.hs b/src/Version.hs new file mode 100644 --- /dev/null +++ b/src/Version.hs @@ -0,0 +1,4 @@ +module Version where + +banner :: String +banner = "Attribute Grammar compiler / HUT project. Version 0.9.38.6" diff --git a/uuagc-bootstrap.cabal b/uuagc-bootstrap.cabal new file mode 100644 --- /dev/null +++ b/uuagc-bootstrap.cabal @@ -0,0 +1,84 @@ +cabal-version: >=1.2 +build-type: Simple +name: uuagc-bootstrap +version: 0.9.38.6.1 +license: GPL +license-file: LICENSE +maintainer: Arie Middelkoop +homepage: http://www.cs.uu.nl/wiki/HUT/WebHome +description: Generates Haskell files from an attribute grammar specification +synopsis: Attribute Grammar System of Universiteit Utrecht +category: Development +stability: Stable +copyright: Universiteit Utrecht +extra-source-files: README + +executable uuagc-bootstrap + build-depends: base >= 4, base < 5, ghc-prim >= 0.2.0.0 + build-depends: containers >= 0.3, directory >= 1.0.1.1, array >= 0.3.0.1 + build-depends: haskell98 >= 1.0.1.1, uulib >= 0.9.12, mtl >= 1.1.1.1 + build-depends: haskell-src-exts >= 1.11.1 + main-is: Ag.hs + other-modules: Ag + , CommonTypes + , DepTypes + , GrammarInfo + , HsTokenScanner + , Options + , PPUtil + , Parser + , Pretty + , Scanner + , SequentialComputation + , SequentialTypes + , Streaming + , TokenDef + , Version + , AbstractSyntax + , AbstractSyntaxDump + , Code + , CodeSyntax + , CodeSyntaxDump + , ConcreteSyntax + , DeclBlocks + , DefaultRules + , Desugar + , ErrorMessages + , Expression + , GenerateCode + , HsToken + , Interfaces + , InterfacesRules + , Order + , Patterns + , PrintCode + , PrintOcamlCode + , PrintVisitCode + , PrintErrorMessages + , SemHsTokens + , Transform + , ATermWrite + , ATermAbstractSyntax + , TfmToVisage + , Visage + , VisageSyntax + , VisagePatterns + , AG2AspectAG + , RhsCheck + , Knuth1 + , KennedyWarren + , KWOrder + , ExecutionPlan + , ExecutionPlan2Hs + extensions: TypeSynonymInstances, MultiParamTypeClasses + hs-source-dirs: src, src-derived + +library + build-depends: base >= 4, base < 5, Cabal >= 1.8.0.6, directory >= 1.0.1.1 + build-depends: process >= 1.0.1.3, uulib >= 0.9.12, filepath >= 1.1.0.4, mtl >= 2.0.1.0 + hs-source-dirs: cabal-plugin/src + exposed-modules: Distribution.Simple.UUAGC + other-modules: Distribution.Simple.UUAGC.UUAGC, + Distribution.Simple.UUAGC.Parser, + Distribution.Simple.UUAGC.AbsSyn, + Distribution.Simple.UUAGC.Options