packages feed

grammar-combinators (empty) → 0.1

raw patch · 43 files changed

+5275/−0 lines, 43 filesdep +MaybeTdep +basedep +containerssetup-changed

Dependencies added: MaybeT, base, containers, enumerable, fgl, graphviz, mtl, multirec, parsec, template-haskell, uu-parsinglib

Files

+ COPYING.GPL view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ COPYING.LGPL view
@@ -0,0 +1,165 @@+                   GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++  This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++  0. Additional Definitions.++  As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++  "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++  An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++  A "Combined Work" is a work produced by combining or linking an+Application with the Library.  The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++  The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++  The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++  1. Exception to Section 3 of the GNU GPL.++  You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++  2. Conveying Modified Versions.++  If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++   a) under this License, provided that you make a good faith effort to+   ensure that, in the event an Application does not supply the+   function or data, the facility still operates, and performs+   whatever part of its purpose remains meaningful, or++   b) under the GNU GPL, with none of the additional permissions of+   this License applicable to that copy.++  3. Object Code Incorporating Material from Library Header Files.++  The object code form of an Application may incorporate material from+a header file that is part of the Library.  You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++   a) Give prominent notice with each copy of the object code that the+   Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the object code with a copy of the GNU GPL and this license+   document.++  4. Combined Works.++  You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++   a) Give prominent notice with each copy of the Combined Work that+   the Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the Combined Work with a copy of the GNU GPL and this license+   document.++   c) For a Combined Work that displays copyright notices during+   execution, include the copyright notice for the Library among+   these notices, as well as a reference directing the user to the+   copies of the GNU GPL and this license document.++   d) Do one of the following:++       0) Convey the Minimal Corresponding Source under the terms of this+       License, and the Corresponding Application Code in a form+       suitable for, and under terms that permit, the user to+       recombine or relink the Application with a modified version of+       the Linked Version to produce a modified Combined Work, in the+       manner specified by section 6 of the GNU GPL for conveying+       Corresponding Source.++       1) Use a suitable shared library mechanism for linking with the+       Library.  A suitable mechanism is one that (a) uses at run time+       a copy of the Library already present on the user's computer+       system, and (b) will operate properly with a modified version+       of the Library that is interface-compatible with the Linked+       Version.++   e) Provide Installation Information, but only if you would otherwise+   be required to provide such information under section 6 of the+   GNU GPL, and only to the extent that such information is+   necessary to install and execute a modified version of the+   Combined Work produced by recombining or relinking the+   Application with a modified version of the Linked Version. (If+   you use option 4d0, the Installation Information must accompany+   the Minimal Corresponding Source and Corresponding Application+   Code. If you use option 4d1, you must provide the Installation+   Information in the manner specified by section 6 of the GNU GPL+   for conveying Corresponding Source.)++  5. Combined Libraries.++  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 that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++   a) Accompany the combined library with a copy of the same work based+   on the Library, uncombined with any other library facilities,+   conveyed under the terms of this License.++   b) Give prominent notice with the combined library that part of it+   is a work based on the Library, and explaining where to find the+   accompanying uncombined form of the same work.++  6. Revised Versions of the GNU Lesser General Public License.++  The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++  Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++  If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ Setup.hs view
@@ -0,0 +1,5 @@+#! /usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain+
+ Text/GrammarCombinators/Base.hs view
@@ -0,0 +1,34 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+module Text.GrammarCombinators.Base (+  module Text.GrammarCombinators.Base.Domain,+  module Text.GrammarCombinators.Base.Grammar,+  module Text.GrammarCombinators.Base.Processor,+  module Text.GrammarCombinators.Base.ProductionRule,+  module Text.GrammarCombinators.Base.MultiRec,+  module Text.GrammarCombinators.Base.Token+  ) where++import Text.GrammarCombinators.Base.Domain+import Text.GrammarCombinators.Base.Grammar+import Text.GrammarCombinators.Base.Processor+import Text.GrammarCombinators.Base.ProductionRule+import Text.GrammarCombinators.Base.MultiRec hiding (cast)+import Text.GrammarCombinators.Base.Token
+ Text/GrammarCombinators/Base/Domain.hs view
@@ -0,0 +1,132 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Text.GrammarCombinators.Base.Domain (+    DomainMap(supIx, subIx),+    DomainEmbedding(supPF), +    SubVal(MkSubVal, unSubVal),+    IxMapId, IxMapBase, IxMapSeq, ApplyIxMap, +    MemoFam(toMemo, fromMemo), Memo, memoFamily,+    FoldFam(foldFam),+    EqFam(overrideIdx, eqIdx), overrideIdxK, +    ShowFam(showIdx),+    Domain,+    memoFamilyK, toMemoK, fromMemoK,+    LiftFam(liftIdxE, liftIdxP)+  ) where++import Generics.MultiRec.Base+import Generics.MultiRec.HFunctor++import Language.Haskell.TH.Syntax (Exp, Pat)++data IxMapId+data IxMapBase (m :: * -> *)+data IxMapSeq (l1 :: *) (l2 :: * -> *)+type family ApplyIxMap (m :: *) ix+type instance ApplyIxMap (IxMapBase m) ix = m ix+type instance ApplyIxMap (IxMapSeq l1 l2) ix = ApplyIxMap l1 (l2 ix)+type instance ApplyIxMap IxMapId ix = ix++class MemoFam (phi :: * -> *) where+  data Memo phi :: (* -> *) -> *+  fromMemo :: Memo phi v -> (forall ix. phi ix -> v ix)+  toMemo :: (forall ix. phi ix -> v ix) -> Memo phi v++memoFamily :: (MemoFam phi) =>+              (forall ix. phi ix -> v ix) -> (forall ix. phi ix -> v ix)  +memoFamily f = fromMemo (toMemo f)++memoFamilyK :: (MemoFam phi) =>+               (forall ix. phi ix -> v) -> (forall ix. phi ix -> v)+memoFamilyK f = fromMemoK (toMemoK f) +toMemoK :: (MemoFam phi) =>+           (forall ix. phi ix -> v) -> Memo phi (K0 v)+toMemoK f = toMemo (K0 . f)+fromMemoK :: (MemoFam phi) =>+             Memo phi (K0 v) -> phi ix -> v+fromMemoK m = unK0 . fromMemo m++-- | A domain 'phi' that is an instance of the 'FoldFam' type class supports +-- folding over all non-terminals in the domain using the 'foldFam' function.+class FoldFam phi where+  -- | Fold a given function over all non-terminals in the domain 'phi'.+  foldFam :: (forall ix. phi ix -> b -> b) -> b -> b++-- | A domain 'phi' that is an instance of the 'ShowFam' type class supports +-- conversion of non-terminal proof terms to Strings using the 'showIdx' function.+class ShowFam phi where+  -- | Convert a given non-terminal proof term to a String representation.+  showIdx :: forall ix. phi ix -> String++-- | A domain 'phi' that is an instance of the 'EqFam' type class supports +-- overriding a function over the full domain at a single non-terminal using +-- the |overrideIdx| function.+class EqFam phi where+  -- | Test equality of two given non-terminal proof terms.+  eqIdx :: forall ix1 ix2. phi ix1 -> phi ix2 -> Bool+  eqIdx idx1 = overrideIdxK (const False) idx1 True +  -- | Override a function over the full domain at a single non-terminal.+  overrideIdx :: (forall ix'. phi ix' -> r ix') -> phi oix ->+                 r oix -> phi ix -> r ix++-- | Similar to the 'overrideIdx' function, but limited to functions whose result type is +-- the same for all non-terminals.+overrideIdxK :: (EqFam phi) => (forall ix'. phi ix' -> v) -> phi oix -> v -> phi ix -> v+overrideIdxK f idx v = unK0 . overrideIdx (K0 . f) idx (K0 v)++-- | A decent Domain 'phi' should instantiate the 'FoldFam', 'ShowFam', 'EqFam' and 'MemoFam'. Avoid+-- using this type class in constraints, use more specific type classes whenever possible.+-- +-- Note: instances for this type class are not automatically derived, and you have to manually instantiate +-- it with an empty implementation block.+class (FoldFam phi,+       ShowFam phi,+       EqFam phi,+       MemoFam phi) => Domain phi++class DomainMap phi phi' supIxT where+  supIx :: phi' ix -> phi (supIxT ix)+  subIx :: phi (supIxT ix) -> phi' ix+  +class (DomainMap phi phi' supIxT) =>+      DomainEmbedding phi phi' supIxT where+  supPF :: (HFunctor phi (PF phi)) =>+           phi' ix -> phi (supIxT ix) ->+           PF phi' (SubVal supIxT r) ix -> PF phi r (supIxT ix)++-- | A generic wrapper type that restricts a semantic value family over a bigger domain+-- to a smaller domain.+data SubVal (supIxT :: * -> *) v ix = MkSubVal {+       unSubVal :: v (supIxT ix)+       } deriving (Show)++class LiftFam phi where+  liftIdxE :: phi ix -> Exp+  liftIdxP :: phi ix -> Pat
+ Text/GrammarCombinators/Base/Grammar.hs view
@@ -0,0 +1,70 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Base.Grammar  where++import Text.GrammarCombinators.Base.ProductionRule+import Text.GrammarCombinators.Base.MultiRec++type RegularRule phi r t v =+  forall p. (ProductionRule p, EpsProductionRule p, TokenProductionRule p t) =>+  p v++type ContextFreeRule phi r t v =+  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t) =>+  p v++type ExtendedContextFreeRule phi r t v =+  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r) =>+  p v++type LiftableContextFreeRule phi r t v =+  forall p. (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r, TokenProductionRule p t) =>+  p v++type ExtendedLiftableContextFreeRule phi r t v =+  forall p. (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r) =>+  p v++type GGrammar rt phi t r rr = +  forall ix. phi ix -> rt phi r t (rr ix)+type AGrammar rt phi t = forall r. GGrammar rt phi t r (PF phi r)+type PGrammar rt phi t r = GGrammar rt phi t r r++type GRegularGrammar phi t r rr = GGrammar RegularRule phi t r rr+type GContextFreeGrammar phi t r rr = GGrammar ContextFreeRule phi t r rr+type GLContextFreeGrammar phi t r rr = GGrammar LiftableContextFreeRule phi t r rr+type GExtendedContextFreeGrammar phi t r rr = GGrammar ExtendedContextFreeRule phi t r rr+type GLExtendedContextFreeGrammar phi t r rr = GGrammar ExtendedLiftableContextFreeRule phi t r rr++type ContextFreeGrammar phi t = AGrammar ContextFreeRule phi t+type LContextFreeGrammar phi t = AGrammar LiftableContextFreeRule phi t+type ExtendedContextFreeGrammar phi t = AGrammar ExtendedContextFreeRule phi t+type LExtendedContextFreeGrammar phi t = AGrammar ExtendedLiftableContextFreeRule phi t++type ProcessingRegularGrammar phi t r = PGrammar RegularRule phi t r+type ProcessingContextFreeGrammar phi t r = PGrammar ContextFreeRule phi t r+type ProcessingLContextFreeGrammar phi t r = PGrammar LiftableContextFreeRule phi t r+type ProcessingExtendedContextFreeGrammar phi t r = PGrammar ExtendedContextFreeRule phi t r+type ProcessingLExtendedContextFreeGrammar phi t r = PGrammar ExtendedLiftableContextFreeRule phi t r
+ Text/GrammarCombinators/Base/MultiRec.hs view
@@ -0,0 +1,86 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Base.MultiRec(+    module Generics.MultiRec.Base,+    module Generics.MultiRec.HFunctor,+    IL(IL, unIL),+    SubPF(SubPF)+  ) where++import Text.GrammarCombinators.Base.Domain++import Control.Applicative++import Generics.MultiRec.Base+import Generics.MultiRec.HFunctor++-- Similar to MultiRec's I type functor, but represents a list of elements+-- of the given type instead of a single value+data IL xi r ix = IL {+  unIL :: [r xi]+  }++instance (El phi xi) => HFunctor phi (IL xi) where+  hmapA = hmapAIL++hmapAIL :: forall phi a r r' xi ix. (Applicative a, El phi xi) => (forall ix1. phi ix1 -> r ix1 -> a (r' ix1))+     -> phi ix -> IL xi r ix -> a (IL xi r' ix)+hmapAIL f _ (IL l) = +  let+    as :: [a (r' xi)]+    as = map (f proof) l+    as' :: a [r' xi]+    as' = foldr (liftA2 (:)) (pure []) as+  in liftA IL as'++-- SubPF allows including an embedded domain's PF instance in the PF +-- instance for the enclosing domain.++-- unusedPhi' is unused, but is here to avoid the need for the+-- UndecidableInstances extension in e.g. the HFunctor instance below+data SubPF (phi :: * -> *) (phi' :: * -> *) unusedPhi' supIxT r ix where +  SubPF :: phi' ix -> PF phi' (SubVal supIxT r) ix -> SubPF phi phi' phi' supIxT r (supIxT ix)++instance (HFunctor phi' (PF phi'), DomainEmbedding phi phi' supIxT) =>+         HFunctor phi (SubPF phi phi' phi' supIxT) where+  hmapA = hmapSubPF++hmapSubPF :: forall phi r a r' phi' supIxT ix.+             (Applicative a, HFunctor phi' (PF phi'), DomainEmbedding phi phi' supIxT) =>+             (forall ix1. phi ix1 -> r ix1 -> a (r' ix1)) ->+             phi ix ->+             SubPF phi phi' phi' supIxT r ix ->+             a (SubPF phi phi' phi' supIxT r' ix)+hmapSubPF f _ (SubPF (idx :: phi' ix') pfb) = +  let+    subF :: forall ix2. phi' ix2 -> SubVal supIxT r ix2 -> a (SubVal supIxT r' ix2)+    subF idx' v = liftA MkSubVal $ f (supIx idx') $ unSubVal v+    pfm :: a (PF phi' (SubVal supIxT r') ix')+    pfm = hmapA subF idx pfb+  in liftA (SubPF idx) pfm+
+ Text/GrammarCombinators/Base/Processor.hs view
@@ -0,0 +1,94 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}++module Text.GrammarCombinators.Base.Processor ( +  GProcessor,+  Processor,+  identityProcessor,+  trivialProcessor,+  applyProcessor,+  applyProcessorL,+  applyProcessorLE,+  applyProcessorE+  ) where++import Text.GrammarCombinators.Base.Grammar+import Text.GrammarCombinators.Base.Domain+import Text.GrammarCombinators.Base.MultiRec+import Text.GrammarCombinators.Base.ProductionRule++import Language.Haskell.TH.Syntax (Q, Exp)++type GProcessor phi r rr = forall ix. phi ix -> rr ix -> r ix+type Processor phi r = GProcessor phi r (PF phi r)++-- | A trivial identity processor that keeps current production+-- rule results unmodified.+identityProcessor :: GProcessor phi r r+identityProcessor _ v = v++applyProcessor' ::+  (ProductionRule p, EpsProductionRule p) =>+  (forall ix . phi ix -> p (r ix)) ->+  GProcessor phi r' r -> +  (forall ix . phi ix -> p (r' ix))+applyProcessor' grammar proc idx =+  proc idx $>> grammar idx ++-- | Apply a given processor to a given context-free grammar.+applyProcessor ::+  GContextFreeGrammar phi t r rr ->+  GProcessor phi rr' rr ->+  GContextFreeGrammar phi t r rr'+applyProcessor gram proc idx = applyProcessor' gram proc idx++applyProcessorL ::+  (LiftFam phi) =>+  GLContextFreeGrammar phi t r rr ->+  GProcessor phi rr' rr ->+  Q Exp -> +  GLContextFreeGrammar phi t r rr'+applyProcessorL gram proc q idx = (proc idx, [| $(q) $(return $ liftIdxE idx) |]) $|>> gram idx++-- | Apply a given processor to a given extended context-free+-- grammar.+applyProcessorE ::+  GExtendedContextFreeGrammar phi t r rr ->+  GProcessor phi rr' rr ->+  GExtendedContextFreeGrammar phi t r rr'+applyProcessorE gram proc idx = applyProcessor' gram proc idx++-- | Apply a given processor to a given extended liftable context-free+-- grammar.+applyProcessorLE ::+  (LiftFam phi) =>+  GLExtendedContextFreeGrammar phi t r rr ->+  GProcessor phi rr' rr ->+  Q Exp ->+  GLExtendedContextFreeGrammar phi t r rr'+applyProcessorLE gram proc q idx = (proc idx, [| $(q) $(return $ liftIdxE idx) |]) $|>> gram idx++-- | A trivial processor that throws everything away and returns +-- a value of the type K0 ().+trivialProcessor :: Processor phi (K0 ())+trivialProcessor _ _ = K0 ()
+ Text/GrammarCombinators/Base/ProductionRule.hs view
@@ -0,0 +1,164 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Text.GrammarCombinators.Base.ProductionRule where++import Text.GrammarCombinators.Base.Domain+import Text.GrammarCombinators.Base.Token+import Text.GrammarCombinators.Base.MultiRec++import Language.Haskell.TH.Syntax (Q, Exp, Lift, lift)++infixl 1 |||+infixl 3 >>>+infixl 3 *>>>+infixl 3 >>>*+infixl 3 $>>+infixl 3 $>>*++-- | Base type class for production rule interpretations. A production rule+-- interpretation that is an instance of the 'ProductionRule' type class supports+-- sequencing and disjunction of rules, empty rules, dead rules and end-of-input +-- rules.+class ProductionRule p where+  -- | Sequence two rules. Result of the sequenced rule is the application+  -- of the result of the first rule to the result of the second.+  (>>>) :: p (a -> b) -> p a -> p b+  -- | Disjunction of two rules.+  (|||) :: p va -> p va -> p va+  -- | End of input rule. Matches only at end of input, consumes nothing,+  -- produces '()' as result.+  endOfInput :: p ()+  -- | Dead rule. Never matches.+  die :: p a++class (ProductionRule p) => LiftableProductionRule p where+  -- | Epsilon rule with lifted value. Always matches, consumes nothing, produces+  --   the given value (with its lifted version) as result.+  epsilonL :: a -> Q Exp -> p a+  -- | Optionally match a given rule.+  optionally :: p v -> p (Maybe v)+  optionally r =   epsilonL Just [|Just|] >>> r+               ||| epsilonL Nothing [|Nothing|]++epsilonLS :: (Lift v, LiftableProductionRule p) => v -> p v+epsilonLS v = epsilonL v $ lift v++class (LiftableProductionRule p) => EpsProductionRule p where+  -- | Epsilon rule. Always matches, consumes nothing, produces+  --   the given value as result.+  epsilon :: a -> p a++-- | Type class for production rules matching tokens of a certain+-- token type 't'.+-- 't' should be an instance of the 'Token' type class.+class TokenProductionRule p t | p -> t where+  -- | Match a given token of type 't' and produce its concrete+  -- value (of type 'ConcreteToken' t).+  token :: t -> p (ConcreteToken t)+ +-- | Sequence two rules, but drop the result of the first.+(*>>>) :: (ProductionRule p, LiftableProductionRule p) => p a -> p b -> p b+a *>>> b = epsilonL (flip const) [| flip const |] >>> a >>> b+-- | Sequence two rules, but drop the result of the second.+(>>>*) :: (ProductionRule p, LiftableProductionRule p) => p a -> p b -> p a+a >>>* b = epsilonL const [|const|] >>> a >>> b++-- | Apply a given function to the result of a given rule.+($>>) :: EpsProductionRule p => (a -> b) -> p a -> p b+v $>> r = epsilon v >>> r+-- | Replace a rule's result value with a given value.+($>>*) :: EpsProductionRule p => a -> p b -> p a+v $>>* r = epsilon v >>>* r++-- | Apply a given function to the result of a given rule.+($|>>) :: LiftableProductionRule p => (a -> b, Q Exp) -> p a -> p b+(v,q) $|>> r = epsilonL v q >>> r+-- | Replace a rule's result value with a given value.+($|>>*) :: LiftableProductionRule p => (a, Q Exp) -> p b -> p a+(v,q) $|>>* r = epsilonL v q >>>* r++-- | Production rule interpretations supporting the 'RecProductionRule' type class support references+-- to non-terminals in a given domain 'phi'. The type of the result values of the rules is determined+-- by semantic value family 'r'.+class RecProductionRule p phi r | p -> phi, p -> r where+  -- | Reference a given non-terminal in a production rule.+  ref :: phi ix -> p (r ix)++-- | Production rule interpretations supporting the 'LoopProductionRule' +-- type class allow for Kleene-star quantified references to +-- non-terminals (zero or more, see the 'manyRef' function) as well+-- as '+'-quantified references to non-terminals (one or more, see+-- the 'many1Ref' function).+--+-- An instance can implement either manyRef or many1Ref,+-- both or neither. Not implementing either produces +-- old-style many and many1 combinator behaviour (discouraged+-- for most situations)+class (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r) =>+      LoopProductionRule p phi r | p -> phi, p -> r where+  -- | Match a given non-terminal zero or more times.+  manyRef :: phi ix -> p [r ix]+  manyRef idx = epsilonL [] [| [] |] ||| many1Ref idx+  -- | Match a given non-terminal one or more times.+  many1Ref :: phi ix -> p [r ix] +  many1Ref idx = ((:), [| (:) |]) $|>> ref idx >>> manyRef idx++-- | The 'SuperProductionRule| type class is in an experimental state, and +-- currently not intended for general use.+class SuperProductionRule p where+  subref :: (DomainEmbedding phi phi' supIxT,+             HFunctor phi (PF phi),+             ProductionRule (p phi ixT r t),+             ProductionRule (p phi' (IxMapSeq ixT supIxT) (SubVal supIxT r) t)) =>+            (forall ix'. phi' ix' -> p phi' (IxMapSeq ixT supIxT) (SubVal supIxT r) t (PF phi' (SubVal supIxT r) ix')) ->+            phi' ix -> phi (supIxT ix) ->+            p phi ixT r t (PF phi r (supIxT ix))++-- | Match any token in a given range of tokens.+tokenRange :: forall p t . (ProductionRule p, TokenProductionRule p t) => [t] -> p (ConcreteToken t)+tokenRange [] = error "empty range"+tokenRange [c] = token c+tokenRange (c : r) = token c ||| tokenRange r++-- | Consecutively match a given list of tokens and return their concrete token values as a list.+string :: forall p t . (ProductionRule p, LiftableProductionRule p, TokenProductionRule p t) => [t] -> p [ConcreteToken t]+string = foldr ((>>>) . (((:),[|(:)|]) $|>>) . token) (epsilonL [] [|[]|])++-- | An old style 'many' combinator. Produces an infinite rule similar to Parsec's many rule. +-- Prefer to use the 'manyRef' function whenever possible.+manyInf :: (ProductionRule p, LiftableProductionRule p) => p a -> p [a]+manyInf r =     epsilonL (:) [|(:)|] >>> r >>> manyInf r+            ||| epsilonL [] [|[]|]+++-- | An old style 'many' combinator. Produces an infinite rule similar to Parsec's many rule. +-- Prefer to use the 'manyRef' function whenever possible.+many1Inf :: (ProductionRule p, LiftableProductionRule p) => p a -> p [a]+many1Inf r = epsilonL (:) [|(:)|] >>> r >>> manyInf r+
+ Text/GrammarCombinators/Base/Token.hs view
@@ -0,0 +1,73 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++module Text.GrammarCombinators.Base.Token where++import Language.Haskell.TH.Syntax (Lift)++import Data.Enumerable++-- | The 'Token' class identifies a type that can be used as terminal+-- identifier in a grammar definition. The type 't' itself is an+-- abstract identifier, identifying a certain type of terminals, but+-- any value of type 't' can correspond to a possibly infinite numer+-- of values of type 'ConcreteToken t'. For example, if you use a lexer+-- in a simple arithmetic expressions grammar, your lexer would typically+-- return values like 'PLUS', 'MINUS', but also 'INTEGER 42' when a+-- number is lexed. In this case, a separate Token type t would be defined,+-- such that a value 'INTEGER_T' of the 'Token' type t could+-- correspond to all values of the form 'INTEGER n' (for n an Integer)+-- of type 'ConcreteToken t'. A production rule defined as +-- 'token' INTEGER_T would then produce result values of type +-- 'ConcreteToken' t (e.g. INTEGER 42).+-- +-- The requirements on 'Token' types are relatively strict, but this is+-- necessary to make it usable in table-based parser algorithms.+-- We reference the 'Lift' class to allow for compile-time+-- precalculation of tables using Template Haskell (See the LL1 and +-- RealLL1 parsers).+-- +-- Note that in some cases it is inefficient to use Char directly as +-- token type, because of the big amount of tokens. For example when using+-- 'transformLeftCorner', the new domain will contain O(n*t + n^2)+-- non-terminals where n is the amount of non-terminals and t is th +-- number of tokens, so when using this transformation, it is beneficial to+-- use a token type with less token values than 'Char', at+-- least if you will use algorithms that fold over the full new grammar's domain +-- (e.g. 'printGrammar' does, 'printReachableGrammar' doesn't).+class (Show (ConcreteToken t), Eq (ConcreteToken t), Eq t,+       Show t, Ord t, Lift t, Enumerable t) =>+      Token t where+  type ConcreteToken t+  -- | The 'classify' function classifies a given 'ConcreteToken' t into+  -- the value of type t it is represented by. +  classify :: ConcreteToken t -> t+  -- | The 'enumConcreteTokens' function returns a (possibly infinite)+  -- list of all concrete tokens of type 'ConcreteToken t' +  -- corresponding to a given token of 'Token' type t+  enumConcreteTokens :: t -> [ConcreteToken t]+  +instance Token Char where+  type ConcreteToken Char = Char+  classify = id+  enumConcreteTokens c = [c]+
+ Text/GrammarCombinators/Parser/LL1.hs view
@@ -0,0 +1,206 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Text.GrammarCombinators.Parser.LL1 ( +  LL1Table(LL1Table),+  calcLL1Table,+  parseLL1+  ) where++import Data.Set (Set, union, singleton)+import qualified Data.Set as Set+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe++import Control.Monad+import Control.Monad.State++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Parser.TopDown++data FirstSet t = +  FS {+    firstSet :: Set t,+    canBeEmpty :: Bool, +    canBeEOI :: Bool+    } ++type FirstSetGrammar phi t = forall ix. phi ix -> [FirstSet t]++newtype (Domain phi, Token t) => FSCalculator phi ixT (r :: * -> *) t v = MkFSCalculator {+  calcFS :: FirstSetGrammar phi t -> [FirstSet t]+  }+type FirstSetGrammarRec phi ixT r t rr = forall ix. phi ix -> FSCalculator phi ixT r t (rr ix)++unionL :: (Ord a) => [Set a] -> Set a+unionL = foldr Set.union Set.empty+                                             +instance (Domain phi, Token t) => ProductionRule (FSCalculator phi ixT r t) where+  a >>> b = MkFSCalculator $ \g ->+      do FS fsa ea fa <- calcFS a g+         FS fsb eb fb <- calcFS b g+         return $ FS (if ea then fsa `union` fsb else fsa) (ea && eb) (fa || (ea && fb))+  a ||| b = MkFSCalculator disjFS where+    disjFS :: FirstSetGrammar phi t -> [FirstSet t]+    disjFS g = calcFS a g ++ calcFS b g+  die = MkFSCalculator $ \_ -> [FS Set.empty False False]+  endOfInput = MkFSCalculator $ \_ -> [FS Set.empty False True] ++instance (Domain phi, Token t) => EpsProductionRule (FSCalculator phi ixT r t) where+  epsilon _ = MkFSCalculator $ \_ -> [FS Set.empty True False]++instance (Domain phi, Token t) => LiftableProductionRule (FSCalculator phi ixT r t) where+  epsilonL v _ = epsilon v++instance (Token t, Domain phi) => TokenProductionRule (FSCalculator phi ixT r t) t where+  token c = MkFSCalculator $ \_ -> [FS (singleton c) False False]+instance (Domain phi, Token t) => RecProductionRule (FSCalculator phi ixT r t) phi r where+  ref idx = MkFSCalculator $ \g -> [FS (unionL $ map firstSet $ g idx) (any canBeEmpty $ g idx) (any canBeEOI $ g idx)]++fixFSGrammar :: (Domain phi, Token t) => FirstSetGrammarRec phi ixT r t rr -> FirstSetGrammar phi t+fixFSGrammar g idx = calcFS (g idx) $ fixFSGrammar g++data (Token t) => LL1Table phi t = LL1Table {+  ruleForTokenTable :: Memo phi (K0 (Map t Int)),+  ruleForEOITable :: Memo phi (K0 (Maybe Int)),+  ruleForEmptyTable :: Memo phi (K0 (Maybe Int))+  }+                                   +calcLL1Table :: forall phi r t rr. (Token t, Domain phi) =>+                GContextFreeGrammar phi t r rr -> LL1Table phi t+calcLL1Table grammar = +  let+    g :: FirstSetGrammar phi t+    g = fixFSGrammar grammar+    fss :: forall ix. phi ix -> [Set t]+    fss = map firstSet . g+    n :: forall ix. phi ix -> Int+    n = length . fss+    ttableContents :: forall ix. phi ix -> [(t,Int)]+    ttableContents idx = do (fs,i) <- zip (fss idx) [0..n idx-1]+                            c <- Set.toList fs+                            return (c,i)+    rftTable :: forall ix. phi ix -> Map t Int+    rftTable idx = Map.fromListWith notLL1Error $ ttableContents idx+    cbe :: forall ix. phi ix -> [Bool]+    cbe = map canBeEOI . g+    etableContents :: forall ix. phi ix -> [Int]+    etableContents idx = do (True, i) <- zip (cbe idx) [0..n idx-1]+                            return i+    rfeTable :: forall ix. phi ix -> Maybe Int+    rfeTable = listToMaybe . etableContents +    rfnTable :: forall ix. phi ix -> Maybe Int+    rfnTable = listToMaybe . ntableContents +    cbn :: forall ix. phi ix -> [Bool]+    cbn = map canBeEmpty . g+    ntableContents :: forall ix. phi ix -> [Int]+    ntableContents idx = do (True, i) <- zip (cbn idx) [0..n idx-1]+                            return i+    notLL1Error = error "Not LL1"+  in LL1Table (toMemoK rftTable) (toMemoK rfeTable) (toMemoK rfnTable)++newtype LLRule phi ixT r t v = MkLLRule {+  llRuleAlts :: [NonBranchingRule phi r t v]+  }++instance Functor (LLRule phi ixT r t) where+  fmap f (MkLLRule rules) = MkLLRule [fmap f rule | rule <- rules]+instance ProductionRule (LLRule phi ixT r t) where+  (MkLLRule rulesa) >>> (MkLLRule rulesb) =+    let+      seqrule = liftM2 ($) +    in MkLLRule [seqrule rulea ruleb | rulea <- rulesa, ruleb <- rulesb]+  (MkLLRule rulesa) ||| (MkLLRule rulesb) =+    MkLLRule $ rulesa ++ rulesb+  die = MkLLRule []+  endOfInput = MkLLRule [nbrEndOfInput]+  +instance EpsProductionRule (LLRule phi ixT r t) where+  epsilon v = MkLLRule [return v]++instance LiftableProductionRule (LLRule phi ixT r t) where+  epsilonL v _ = MkLLRule [return v]++instance (Token t) => TokenProductionRule (LLRule phi ixT r t) t where+  token t =+    let+      rule = do (c:r) <- MkNBR $ \_ -> get+                if classify c == t +                  then do MkNBR $ \_ -> put r+                          return c+                  else fail $ errWrongToken c+      errWrongToken c =  show c ++ " read when " ++ show t ++ " expected."+    in MkLLRule [rule]+  +instance RecProductionRule (LLRule phi ixT r t) phi r where+  ref idx = MkLLRule [MkNBR $ \g -> get >>= \s -> unNBR (g idx s) g]++newtype WrapNonBranchingRuleList phi r t ix = WrapNBRL {+  unWrapNBRL :: [NonBranchingRule phi r t (r ix)]+  }++ll1Disambiguate :: forall phi r t. (Domain phi, Token t) =>+                   ProcessingContextFreeGrammar phi t r ->+                   LL1Table phi t ->+                   UnambiguousTopDownGrammar phi r t+ll1Disambiguate gram table =+  let+    tableidx :: phi ix -> K0 (Map t Int) ix+    tableidx = fromMemo (ruleForTokenTable table)+    ttable :: phi ix -> Map t Int+    ttable idx = unK0 $ tableidx idx+    eoitable :: phi ix -> Maybe Int+    eoitable idx = unK0 $ fromMemo (ruleForEOITable table) idx+    emptytable :: phi ix -> Maybe Int+    emptytable idx = unK0 $ fromMemo (ruleForEmptyTable table) idx+    tidx :: phi ix -> ConcreteToken t -> Int+    tidx idx c = fromMaybe (emptyidx idx) $ Map.lookup (classify c) $ ttable idx+    eoiidx :: phi ix -> Int+    eoiidx idx = fromMaybe (emptyidx idx) $ eoitable idx+    emptyidx :: phi ix -> Int+    emptyidx idx = fromJust $ emptytable idx+    candidateRules :: phi ix -> [NonBranchingRule phi r t (r ix)]+    candidateRules idx = llRuleAlts $ gram idx+    memoCR :: phi ix -> [NonBranchingRule phi r t (r ix)]+    memoCR = unWrapNBRL . memoFamily (WrapNBRL . candidateRules)+    ruleForString :: phi ix -> [ConcreteToken t] -> NonBranchingRule phi r t (r ix)+    ruleForString idx (c:_) = memoCR idx !! tidx idx c+    ruleForString idx [] = memoCR idx !! eoiidx idx +  in ruleForString++parseLL1 :: forall phi ixT r t ix. (Domain phi, Token t, ProductionRule (LLRule phi ixT r t)) =>+            ProcessingContextFreeGrammar phi t r ->+            LL1Table phi t -> phi ix -> [ConcreteToken t] -> Maybe (r ix)+parseLL1 gram table =+  let+    unambGram :: UnambiguousTopDownGrammar phi r t+    unambGram = ll1Disambiguate gram table+  in parseTopDown unambGram+
+ Text/GrammarCombinators/Parser/LL1TH.hs view
@@ -0,0 +1,52 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RelaxedPolyRec #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}++module Text.GrammarCombinators.Parser.LL1TH (+  prepareLL1TableTH+  ) where  ++import Language.Haskell.TH.Syntax++import Data.Map+  +import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Parser.LL1++instance (Lift k, Lift a) => Lift (Map k a) where+  lift v = [| fromAscList $(lift $ toAscList v)|]++prepareLL1TableTH :: (Domain phi,+                      Token t,+                      Lift (Memo phi (K0 (Map t Int))),+                      Lift (Memo phi (K0 (Maybe Int)))+                      ) =>+                     GContextFreeGrammar phi t r rr -> Q Exp+prepareLL1TableTH grammar = liftLL1Table $ calcLL1Table grammar++liftLL1Table :: (MemoFam phi,+                 Token t,+                 Lift (Memo phi (K0 (Map t Int))),+                 Lift (Memo phi (K0 (Maybe Int)))) =>+                LL1Table phi t -> Q Exp +liftLL1Table (LL1Table a b c) = [| LL1Table $(lift a) $(lift b) $(lift c)|]
+ Text/GrammarCombinators/Parser/Packrat.hs view
@@ -0,0 +1,195 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Text.GrammarCombinators.Parser.Packrat (+  Result (Parsed, NoParse),+  Derivs,+  parsePackrat+  ) where++import Text.GrammarCombinators.Base+  +data Result phi r t v = Parsed v (Derivs phi r t) |+                        NoParse+instance (Show v) => Show (Result phi r t v) where+  show (Parsed v _) = "Parsed " ++ show v ++ " _"+  show NoParse = "NoParse"++instance Functor (Result phi r t) where+  fmap f (Parsed v d) = Parsed (f v) d+  fmap _ NoParse = NoParse++data PRPrimTokenIx+data PREndOfInputIx+data PRBaseIx ix++data PackratDomain phi ix where +  PackratDomainBase :: phi ix -> PackratDomain phi (PRBaseIx ix)+  PackratDomainPrimToken :: PackratDomain phi PRPrimTokenIx+  PackratDomainEndOfInput :: PackratDomain phi PREndOfInputIx+ +instance DomainMap (PackratDomain phi) phi PRBaseIx where+  supIx = PackratDomainBase+  subIx (PackratDomainBase idx) = idx++instance (MemoFam phi) => MemoFam (PackratDomain phi) where+  data Memo (PackratDomain phi) v = PRMemo (v PRPrimTokenIx, v PREndOfInputIx, Memo phi (SubVal PRBaseIx v))+  toMemo f = PRMemo (f PackratDomainPrimToken, f PackratDomainEndOfInput, toMemo $ \idx -> MkSubVal $ f $ PackratDomainBase idx)+  fromMemo (PRMemo (_, _, bm)) (PackratDomainBase idx) = unSubVal $ fromMemo bm idx+  fromMemo (PRMemo (v, _, _)) (PackratDomainPrimToken) = v+  fromMemo (PRMemo (_, v, _)) (PackratDomainEndOfInput) = v++data PackratValue phi t r ix where+  PRPrimTokenValue :: ConcreteToken t -> PackratValue phi t r PRPrimTokenIx+  PREndOfInputValue :: PackratValue phi t r PREndOfInputIx+  PRBaseValue :: r ix -> PackratValue phi t r (PRBaseIx ix)++unPRPrimTokenValue :: PackratValue phi t r PRPrimTokenIx -> ConcreteToken t+unPRPrimTokenValue (PRPrimTokenValue c) = c++newtype PRResult phi r t ix = PRResult {+  unPRResult :: Result phi r t (PackratValue phi t r ix)+  }++newtype Derivs phi r t = Derivs {+  unDerivs :: forall ix. PackratDomain phi ix -> PRResult phi r t ix+  }++buildDerivs :: forall phi r t. (Token t, MemoFam phi) => (forall ix. PackratDomain phi ix -> PRResult phi r t ix) -> Derivs phi r t+buildDerivs f = Derivs memoizedF where+  memoizedF :: forall ix. PackratDomain phi ix -> PRResult phi r t ix+  memoizedF = memoFamily f++type InternalPRRule phi r t v = Derivs phi r t -> Result phi r t v+type InternalGrammar phi r t = forall ix. phi ix -> InternalPRRule phi r t (r ix)+data PackratRule phitop rtop phi ixT r t v =+  PackratRule {+    runParse :: InternalGrammar phitop rtop t ->+                (forall ix. phi ix -> rtop (ApplyIxMap ixT ix) -> r ix) -> +                (forall ix. phi ix -> phitop (ApplyIxMap ixT ix)) ->+                InternalPRRule phitop rtop t v+    }+type PackratGrammar phitop rtop phi ixT rr r t = forall ix. phi ix -> PackratRule phitop rtop phi ixT rr t (r ix)++instance ProductionRule (PackratRule phitop rtop phi ixT r t) where+  a >>> b = PackratRule $ \g rd si d0 -> +    case runParse a g rd si d0 of +      Parsed f d1 -> case runParse b g rd si d1 of+        Parsed x d2 -> Parsed (f x) d2+        _ -> NoParse+      _ -> NoParse+  -- TODO : parameterise disambiguation (keeping only 1st match or all)?+  a ||| b = PackratRule $ \g rd si d ->+    case runParse a g rd si d of+      Parsed v1 d1 -> Parsed v1 d1+      _ -> case runParse b g rd si d of+        Parsed v2 d2 -> Parsed v2 d2+        _ -> NoParse+  die = PackratRule $ \_ _ _ _ -> NoParse+  endOfInput = PackratRule $ \_ _ _ d -> +    case unPRResult $ unDerivs d PackratDomainEndOfInput of+      Parsed _ d' -> Parsed () d'+      _ -> NoParse++instance EpsProductionRule (PackratRule phitop rtop phi ixT r t) where+  epsilon v = PackratRule $ \_ _ _ -> Parsed v++instance LiftableProductionRule (PackratRule phitop rtop phi ixT r t) where+  epsilonL v _ = epsilon v++instance (Token t) => TokenProductionRule (PackratRule phitop rtop phi ixT r t) t where+  token c = PackratRule $ \_ _ _ d -> +    case unPRResult$ unDerivs d PackratDomainPrimToken of+      Parsed v' d' | classify (unPRPrimTokenValue v') == c -> Parsed (unPRPrimTokenValue v') d'+      _ -> NoParse++instance RecProductionRule (PackratRule phitop rtop phi ixT r t) phi r where+  ref (idx :: phi ix) =+    PackratRule $ \grammar rd si d ->+      fmap (rd idx) $ grammar (si idx) d+      ++toInternalGrammar :: PackratGrammar phi r phi IxMapId r r t -> InternalGrammar phi r t+toInternalGrammar g idx =+    runParse (g idx) (toInternalGrammar g) (\_ -> id) id++parsePackratAll :: forall phi r t. (Token t, MemoFam phi) => InternalGrammar phi r t -> [ConcreteToken t] -> Derivs phi r t+parsePackratAll grammar s =+  let+    derivs :: forall ix. PackratDomain phi ix -> PRResult phi r t ix+    derivs (PackratDomainPrimToken) = case s of +      (c:s') -> PRResult $ Parsed (PRPrimTokenValue c) (parsePackratAll grammar s')+      _ -> PRResult NoParse+    derivs (PackratDomainBase ruleId) = PRResult $ fmap PRBaseValue $ grammar ruleId (buildDerivs derivs)+    derivs (PackratDomainEndOfInput) = case s of +      [] -> PRResult $ Parsed PREndOfInputValue $ Derivs $ const $ PRResult NoParse+      _ -> PRResult NoParse+  in buildDerivs derivs++instance SuperProductionRule (PackratRule phitop rtop) where+  subref = prSubRef++prSubRef :: forall phitop phi phi' rtop r ixT t ix supIxT . (DomainEmbedding phi phi' supIxT, HFunctor phi (PF phi)) =>+            (forall ix'. phi' ix' -> PackratRule phitop rtop phi' (IxMapSeq ixT supIxT) (SubVal supIxT r) t (PF phi' (SubVal supIxT r) ix')) ->+            phi' ix -> phi (supIxT ix) -> +            PackratRule phitop rtop phi ixT r t (PF phi r (supIxT ix))+prSubRef subgram idxb idx = PackratRule $ \outgram rd supIxTop ->+  let +    subrule :: PackratRule phitop rtop phi' (IxMapSeq ixT supIxT) (SubVal supIxT r) t (PF phi' (SubVal supIxT r) ix)+    subrule = subgram idxb+    rd' :: forall ix' . phi' ix' -> rtop (ApplyIxMap ixT (supIxT ix')) -> SubVal supIxT r ix'+    rd' idx' v = MkSubVal $ rd (supIx idx') v+    supIx' :: forall ix' . phi' ix' -> phitop (ApplyIxMap ixT (supIxT ix'))+    supIx' idx' = supIxTop (supIx idx' :: phi (supIxT ix'))+    oprrule :: InternalPRRule phitop rtop t (PF phi' (SubVal supIxT r) ix)+    oprrule = runParse subrule outgram rd' supIx'+    nprrule :: InternalPRRule phitop rtop t (PF phi r (supIxT ix))+    nprrule = fmap (supPF idxb idx) . oprrule +  in nprrule ++instance LoopProductionRule (PackratRule phitop rtop phi ixT r t) phi r where+  manyRef = manyInf . ref++-- | Parse a given string according to a given grammar, starting from a given start non-terminal,+-- with a backtracking Packrat parser algorithm (like backtracking recursive descent, but with +-- linear performance in the length of the input).+parsePackrat :: forall phi r ix t. (Token t, MemoFam phi) =>+                ProcessingContextFreeGrammar phi t r ->+                phi ix -> [ConcreteToken t] -> Result phi r t (r ix)+parsePackrat usergram ruleId s = +  let +    grammar :: forall ix'. phi ix' -> Derivs phi r t -> Result phi r t (r ix')+    grammar = toInternalGrammar usergram+    result :: Result phi r t (PackratValue phi t r (PRBaseIx ix))+    result = unPRResult $ unDerivs (parsePackratAll grammar s) (PackratDomainBase ruleId) +  in case result of+    Parsed (PRBaseValue v) d -> Parsed v d+    _ -> NoParse+
+ Text/GrammarCombinators/Parser/Parsec.hs view
@@ -0,0 +1,74 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Compatibility component for the Parsec library.+module Text.GrammarCombinators.Parser.Parsec (+  parseParsec+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Transform.UnfoldRecursion++import Text.Parsec+import Text.Parsec.Pos+import qualified Text.Parsec as Parsec+--import Text.ParserCombinators.Parsec.Prim++newtype WrapGenParser t v = WGP { unWGP :: Parsec [ConcreteToken t] () v }++instance (Token t) => ProductionRule (WrapGenParser t) where+  a >>> b = WGP $ do f <- unWGP a; x <- unWGP b; return $ f x+  a ||| b = WGP $ try (unWGP a) <|> unWGP b+  endOfInput = WGP eof+  die = WGP parserZero++instance (Token t) => EpsProductionRule (WrapGenParser t) where+  epsilon v = WGP $ return v++instance (Token t) => LiftableProductionRule (WrapGenParser t) where+  epsilonL v _ = epsilon v++instance (Token t) => TokenProductionRule (WrapGenParser t) t where+  token tt = WGP $ tokenPrim show nextPos testToken+    where+      testToken t        = if classify t == tt then Just t else Nothing+      nextPos p _ _  = newPos (sourceName p) (sourceLine p) (sourceColumn p+1)++-- | Parse a given string according to a given grammar, starting from a given start+--   non-terminal, using the Parsec parser library. Currently uses backtracking for+--   every branch.+--  +--   It is probably possible to automatically approximate +--   branches where backtracking is required, which would be neat and really go beyond+--   what is currently possible in Parsec. Help welcome!+parseParsec :: forall phi t r ix.+               (Token t) =>+               ProcessingContextFreeGrammar phi t r ->+               phi ix -> SourceName -> [ConcreteToken t] -> Either ParseError (r ix)+parseParsec gram idx = +  let irule :: WrapGenParser t (r ix)+      irule = unfoldRecursion gram idx+      parser = unWGP irule+  in Parsec.parse parser
+ Text/GrammarCombinators/Parser/RealLL1.hs view
@@ -0,0 +1,194 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE KindSignatures #-}++-- | This is an experiment, do not use.+module Text.GrammarCombinators.Parser.RealLL1 (+  FirstSet(FS,firstTokens,canBeEmpty,canBeEOI),+  BranchSelectorMemo(DefaultBranchSelectorMemo,SplitBranchSelectorMemoL, FlipBS),+  RealLL1Table (MkRealLL1Table),+  parseRealLL1, +  prepareLL1Parser,+  ) where++import Text.GrammarCombinators.Base++import Control.Monad.Maybe+import Control.Monad.State++import Data.Set +import qualified Data.Set as Set++data (Token t) => FirstSet t = +  FS {+    firstTokens :: Set t,+    canBeEmpty :: Bool, +    canBeEOI :: Bool+    } deriving (Show)++data BranchSelector t = MkBS { +  selectBranch :: forall a. [ConcreteToken t] -> a -> a -> (a, BranchSelector t)+  }++defaultBranchSelector :: BranchSelector t+defaultBranchSelector = +  MkBS (error "defaultBranchSelector selecting branch???")++data BranchSelectorMemo t =+    DefaultBranchSelectorMemo+  | SplitBranchSelectorMemoL (FirstSet t) (BranchSelectorMemo t) (BranchSelectorMemo t)+  | FlipBS (BranchSelectorMemo t)++unBranchSelectorMemo :: (Token t) => BranchSelectorMemo t -> BranchSelector t+unBranchSelectorMemo DefaultBranchSelectorMemo = defaultBranchSelector+unBranchSelectorMemo (SplitBranchSelectorMemoL fs bsm1 bsm2) = +  let bs1 = unBranchSelectorMemo bsm1+      bs2 = unBranchSelectorMemo bsm2+      selBranch fts _ (t:_) b1 b2 = if classify t `member` fts then (b1,bs1) else (b2,bs2)+      selBranch _ f [] b1 b2 = if f then (b1,bs1) else (b2,bs2)+  in MkBS $ selBranch (firstTokens fs) (canBeEOI fs)+unBranchSelectorMemo (FlipBS bsm) =+  let bs = unBranchSelectorMemo bsm+  in MkBS $ \s b1 b2 -> selectBranch bs s b2 b1++data BranchData t = MkBD {+  branchSelector :: BranchSelectorMemo t,+  seqBS :: BranchSelectorMemo t -> BranchSelectorMemo t,+  firstSet :: FirstSet t+  }++type BranchSelectorGrammar phi t = forall ix. phi ix -> BranchData t++newtype (Domain phi, Token t) => BranchSelectorComputer phi (r :: * -> *) t v = MkBSC {+  branchData :: BranchSelectorGrammar phi t -> BranchData t+  }++type BSCGrammar phi r t rr = forall ix. phi ix -> BranchSelectorComputer phi r t (rr ix)++instance (Domain phi, Token t) => ProductionRule (BranchSelectorComputer phi r t) where+  a >>> b = MkBSC $ \g -> +    let +      bs = seqBS (branchData a g) (branchSelector (branchData b g))+      (FS fsa ea fa) = firstSet $ branchData a g+      (FS fsb eb fb) = firstSet $ branchData b g+      fs = FS (if ea then fsa `union` fsb else fsa) (ea && eb) (fa || (ea && fb))+      nseqbs = seqBS (branchData a g) . seqBS (branchData b g)+    in MkBD bs nseqbs fs+  a ||| b = MkBSC $ \g ->+    let+      fsa = firstSet $ branchData a g+      fsb = firstSet $ branchData b g+      (FS ftsa ea fa) = fsa+      (FS ftsb eb fb) = fsb+      fs = FS (ftsa `union` ftsb) (ea || eb) (fa || fb)+      bsa = branchSelector $ branchData a g+      bsb = branchSelector $ branchData b g+      sb bsa' bsb' = if not ea+           then SplitBranchSelectorMemoL fsa bsa' bsb'+           else FlipBS $ SplitBranchSelectorMemoL fsb bsb' bsa'+      seqbs rbs = sb (seqBS (branchData a g) rbs) (seqBS (branchData a g) rbs)+    in MkBD (sb bsa bsb) seqbs fs+  die = MkBSC $ \_ -> MkBD DefaultBranchSelectorMemo id $ FS Set.empty False False+  endOfInput = MkBSC $ \_ -> MkBD DefaultBranchSelectorMemo id $ FS Set.empty False True++instance (Domain phi, Token t) => LiftableProductionRule (BranchSelectorComputer phi r t) where+  epsilonL v _ = epsilon v++instance (Domain phi, Token t) => EpsProductionRule (BranchSelectorComputer phi r t) where+  epsilon _ = MkBSC $ \_ -> MkBD DefaultBranchSelectorMemo id $ FS Set.empty True False++instance (Token t, Domain phi) => TokenProductionRule (BranchSelectorComputer phi r t) t where+  token tt = MkBSC $ \_ -> +    MkBD DefaultBranchSelectorMemo id $ FS (singleton tt) False False++instance (Token t, Domain phi) => RecProductionRule (BranchSelectorComputer phi r t) phi r where+  ref idx = MkBSC $ \g ->+    MkBD DefaultBranchSelectorMemo id $ firstSet $ g idx++instance (Token t, Domain phi) => LoopProductionRule (BranchSelectorComputer phi r t) phi r where+  manyRef idx = MkBSC $ \g ->+    let+      singleFS = firstSet $ g idx+      multFS = FS (firstTokens singleFS) True (canBeEOI singleFS)+    in MkBD DefaultBranchSelectorMemo id multFS ++fixBSC :: (Domain phi, Token t) => BSCGrammar phi r t rr -> BranchSelectorGrammar phi t+fixBSC gram idx = branchData (gram idx) (fixBSC gram)++data RealLL1Rule phi ixT r t v = MkRealLL1Rule {+  runLL1Rule :: BranchSelector t ->+                (forall ix. phi ix -> BranchSelector t) ->+                (forall ix. phi ix -> RealLL1Rule phi ixT r t (r ix)) ->+                MaybeT (State [ConcreteToken t]) v+  } ++type RealLL1Grammar phi ixT rr r t = (Domain phi, Token t) => phi ix -> RealLL1Rule phi ixT r t (rr ix)++instance ProductionRule (RealLL1Rule phi ixT r t) where+  a >>> b = MkRealLL1Rule $ \cs selg g -> do f <- runLL1Rule a cs selg g+                                             x <- runLL1Rule b cs selg g+                                             return $ f x+  a ||| b = MkRealLL1Rule $ \cs selg g ->+    do s <- get+       let (r,ns) = selectBranch cs s a b+       runLL1Rule r ns selg g+  die = MkRealLL1Rule $ \_ _ _ -> fail "die"+  endOfInput = MkRealLL1Rule $ \_ _ _ -> do [] <- get; return ()+  +instance LiftableProductionRule (RealLL1Rule phi ixT r t) where+  epsilonL v _ = epsilon v++instance EpsProductionRule (RealLL1Rule phi ixT r t) where+  epsilon v = MkRealLL1Rule $ \_ _ _ -> return v++instance (Token t) => TokenProductionRule (RealLL1Rule phi ixT r t) t where+  token tt = MkRealLL1Rule $ \_ _ _ ->+    let +      errWrongToken c = show c ++ " read when " ++ show tt ++ " expected."+    in do (c:r) <- get+          if classify c == tt+            then put r >> return c+            else fail $ errWrongToken c++instance RecProductionRule (RealLL1Rule phi ixT r t) phi r where+  ref idx = MkRealLL1Rule $ \_ selg g ->+    runLL1Rule (g idx) (selg idx) selg g++newtype RealLL1Table phi t = MkRealLL1Table { +  unRealLL1Table :: Memo phi (K0 (BranchSelectorMemo t))+  }++prepareLL1Parser :: (Domain phi, Token t) => BSCGrammar phi r t rr -> RealLL1Table phi t+prepareLL1Parser gram = MkRealLL1Table $ toMemoK $ branchSelector . fixBSC gram++parseRealLL1 :: (Domain phi, Token t) => RealLL1Grammar phi ixT r r t -> RealLL1Table phi t ->+                phi ix -> [ConcreteToken t] -> Maybe (r ix)+parseRealLL1 gram selgmemo idx s =+  let+    selg = unBranchSelectorMemo . fromMemoK (unRealLL1Table selgmemo)+    m = runLL1Rule (gram idx) (selg idx) selg gram+  in evalState (runMaybeT m) s
+ Text/GrammarCombinators/Parser/RecursiveDescent.hs view
@@ -0,0 +1,88 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Text.GrammarCombinators.Parser.RecursiveDescent (+  parseRecDec+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Transform.UnfoldRecursion++import Control.Monad.State+import Control.Monad.Maybe++import Data.Maybe++newtype RecDecRule t v = RecDecRule { runRD :: MaybeT (State [ConcreteToken t]) v } deriving (Monad)++instance MonadPlus (RecDecRule t) where+  mzero = RecDecRule $ fail "mzero"+  ma `mplus` mb =+    RecDecRule $ MaybeT $ do olds <- get+                             result <- runMaybeT $ runRD ma +                             if isNothing result+                               then put olds >> runMaybeT (runRD mb)+                               else return result ++instance ProductionRule (RecDecRule t) where+  (>>>) = liftM2 ($) +  (|||) = mplus+  die = mzero+  endOfInput = RecDecRule $ do [] <- get; return ()+  +instance EpsProductionRule (RecDecRule t) where+  epsilon = return++instance LiftableProductionRule (RecDecRule t) where+  epsilonL v _ = return v++instance (Token t) => TokenProductionRule (RecDecRule t) t where+  token c = +    let +      primToken = RecDecRule $ do (c':r) <- get+                                  put r+                                  return c'+    in do cr <- primToken+          if c == classify cr+            then return cr+            else fail $ "unexpected token " ++ show c ++ ", expecting " ++ show cr++parseRecDecBase :: RecDecRule t a -> [ConcreteToken t] -> Maybe a+parseRecDecBase parser s =+  case flip runState s $ runMaybeT $ runRD parser of+    (v,[]) -> v+    _ -> error "No full parse"++-- | Parse a given string according to a given grammar, starting from a given start non-terminal,+-- with a simple backtracking recursive descent parser algorithm.+parseRecDec :: forall phi t r ix. (Token t) =>+               ProcessingContextFreeGrammar phi t r -> phi ix -> [ConcreteToken t] -> Maybe (r ix)+parseRecDec gram = +  let+    rpwgram :: phi ix -> RecDecRule t (r ix)+    rpwgram = unfoldRecursion gram+  in parseRecDecBase . rpwgram
+ Text/GrammarCombinators/Parser/TopDown.hs view
@@ -0,0 +1,67 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | This was intended as a common library for top-down parser algorithms, but it +-- is a bit outdated and currently only used by the LL1 parser.+module Text.GrammarCombinators.Parser.TopDown where++import Control.Monad.Maybe+import Control.Monad.State++import Text.GrammarCombinators.Base++newtype NonBranchingRule phi r t v = MkNBR {+  unNBR :: (forall ix. phi ix -> [ConcreteToken t] -> NonBranchingRule phi r t (r ix)) -> MaybeT (State [ConcreteToken t]) v+  }++instance Functor (NonBranchingRule phi r t) where+  fmap f r = MkNBR $ \g -> fmap f $ unNBR r g+  +instance Monad (NonBranchingRule phi r t) where+  ra >> rb = MkNBR $ \g -> unNBR ra g >> unNBR rb g+  ra >>= f = MkNBR $ \g -> unNBR ra g >>= \v -> unNBR (f v) g+  return v = MkNBR $ \_ -> return v++nbrEndOfInput :: NonBranchingRule phi r t () +nbrEndOfInput = MkNBR $ \_ -> do [] <- get; return ()++type UnambiguousTopDownGrammar phi r t = (Domain phi, Token t) => phi ix -> [ConcreteToken t] -> NonBranchingRule phi r t (r ix)++newtype WrapLookaheadNBR phi r t ix = WrapLNBR {+  unWrapLNBR :: [ConcreteToken t] -> NonBranchingRule phi r t (r ix)+  }++parseTopDown :: forall phi r t ix. (Domain phi, Token t) => UnambiguousTopDownGrammar phi r t -> phi ix -> [ConcreteToken t] -> Maybe (r ix)+parseTopDown gram idx s =+  let+    memoGram :: UnambiguousTopDownGrammar phi r t+    memoGram = unWrapLNBR . memoFamily (WrapLNBR . gram)+    currule :: NonBranchingRule phi r t (r ix)+    currule = memoGram idx s+    exec :: State [ConcreteToken t] (Maybe (r ix))+    exec = runMaybeT $ unNBR currule gram+  in evalState exec s +
+ Text/GrammarCombinators/Parser/UUParse.hs view
@@ -0,0 +1,100 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | UUParse compatibility module.+module Text.GrammarCombinators.Parser.UUParse (+  parseUU,+  parseUUR,+  parseUURule,+  parseUUE+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Transform.UnfoldRecursion+import Text.GrammarCombinators.Transform.UnfoldLoops++import Text.ParserCombinators.UU hiding (Token)++-- We just count tokens for now (not lines and colums with handling here for newlines etc), +-- locations cannot be used atm anyway...+instance IsLocationUpdatedBy Int t where+   advance p _ = p + 1++newtype WrapP t v = WP { unWP :: P (Str (ConcreteToken t) Int) v }++instance (Token t) => ProductionRule (WrapP t) where+  a >>> b = WP $ unWP a <*> unWP b+  a ||| b = WP $ unWP a <|> unWP b+  endOfInput = WP $ const () <$> pEnd+  die = WP empty++instance (Token t) => EpsProductionRule (WrapP t) where+  epsilon v = WP $ pure v++instance (Token t) => LiftableProductionRule (WrapP t) where+  epsilonL v _ = epsilon v++instance (Token t) => TokenProductionRule (WrapP t) t where+  token tt =+    let+      sat :: ConcreteToken t -> Bool+      sat t = classify t == tt+    in WP $ pSym (sat, show tt, head $ enumConcreteTokens tt)++-- | Parse a given string according to a given regular grammar, starting from a given+-- start symbol using the UUParse error-correcting parsing library (always+-- produces a result)+parseUUR :: forall phi t r ix.+           (Token t) =>+           ProcessingRegularGrammar phi t r ->+           phi ix -> [ConcreteToken t] -> r ix+parseUUR gram idx = parseUURule $ gram idx++-- | Parse a given string according to a given grammar, starting from a given+-- start symbol using the UUParse error-correcting parsing library (always+-- produces a result)+parseUU :: forall phi t r ix.+           (Token t) =>+           ProcessingContextFreeGrammar phi t r ->+           phi ix -> [ConcreteToken t] -> r ix+parseUU gram = parseUUR (unfoldRecursion gram)++-- | Parse a given string according to a given regular production rule using the +-- UUParse error-correcting parsing library (always produces a result).+parseUURule :: forall phi t r v.+           (Token t) =>+           RegularRule phi r t v ->+           [ConcreteToken t] -> v+parseUURule rule s = +  parse (unWP rule) $ listToStr s 0++-- | Parse a given string according to a given extended grammar, starting from a given+-- start symbol using the UUParse error-correcting parsing library (always+-- produces a result)+parseUUE :: forall phi t r ix.+           (Token t) =>+           ProcessingExtendedContextFreeGrammar phi t r ->+           phi ix -> [ConcreteToken t] -> r ix+parseUUE gram = parseUU (unfoldLoops gram)
+ Text/GrammarCombinators/TH/Base.hs view
@@ -0,0 +1,41 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}++module Text.GrammarCombinators.TH.Base where++import Text.GrammarCombinators.Base++import Language.Haskell.TH.Syntax++import Data.Set+import qualified Data.Set as Set++instance (Lift v) => Lift (Set v) where+  lift s = [| Set.fromDistinctAscList $(lift $ toAscList s) |]+++instance Lift v => Lift (K0 v ix) where+  lift (K0 v) = [| K0 $(lift v) |]+  +instance (Lift (v (supIxT ix))) =>+         Lift (SubVal supIxT v ix) where+  lift (MkSubVal v) = [| MkSubVal $(lift v) |]
+ Text/GrammarCombinators/TH/FoldLoops.hs view
@@ -0,0 +1,35 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}++module Text.GrammarCombinators.TH.FoldLoops where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Transform.FoldLoops++import Language.Haskell.TH.Syntax++instance (Lift (Memo phi (SubVal FLBaseIx v)),+          Lift (Memo phi (SubVal FLManyIx v))) =>+         Lift (Memo (FoldLoopsDomain phi) v) where+  lift (FLM mb mm) = [| FLM $(lift mb) $(lift mm) |]
+ Text/GrammarCombinators/TH/RealLL1.hs view
@@ -0,0 +1,41 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}++module Text.GrammarCombinators.TH.RealLL1 where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Parser.RealLL1++import Text.GrammarCombinators.TH.Base ()++import Language.Haskell.TH.Syntax++instance (Token t) => Lift (FirstSet t) where+  lift (FS fts e f) = [| FS $(lift fts) $(lift e) $(lift f) |]++instance (Token t) => Lift (BranchSelectorMemo t) where+  lift DefaultBranchSelectorMemo = [| DefaultBranchSelectorMemo |] +  lift (SplitBranchSelectorMemoL fs bsa bsb) = [| SplitBranchSelectorMemoL $(lift fs) $(lift bsa) $(lift bsb) |]+  lift (FlipBS bsn) = [| FlipBS $(lift bsn) |]++liftRealLL1Table :: (Lift (Memo phi (K0 (BranchSelectorMemo t)))) => RealLL1Table phi t -> Q Exp+liftRealLL1Table (MkRealLL1Table memo) = [| MkRealLL1Table $(lift memo) |]
+ Text/GrammarCombinators/Transform/CombineEpsilons.hs view
@@ -0,0 +1,86 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Transform.CombineEpsilons (+  combineEpsilons,+  combineEpsilonsE+  ) where++import Text.GrammarCombinators.Base++data CombineEpsilonsRule p (phi :: * -> *) (r :: * -> *) t v where+    CERule :: (v' -> v) -> p v' -> CombineEpsilonsRule p phi r t v+    CEEpsRule :: v -> CombineEpsilonsRule p phi r t v++instance (ProductionRule p, EpsProductionRule p) =>+         ProductionRule (CombineEpsilonsRule p phi r t) where+  endOfInput = CERule id endOfInput+  (CEEpsRule va) >>> (CEEpsRule vb) = CEEpsRule $ va vb+  (CEEpsRule va) >>> (CERule fb rb) = CERule (va . fb) rb+  (CERule fa ra) >>> (CEEpsRule vb) = CERule (flip ($) vb . fa)  ra+  (CERule fa ra) >>> (CERule fb rb) = CERule (uncurry fa) ((\va vb -> (va, fb vb)) $>> ra >>> rb) +  ra ||| rb = CERule id $ runCERule ra ||| runCERule rb+  die = CERule id die++instance (EpsProductionRule p) => EpsProductionRule (CombineEpsilonsRule p phi r t) where+  epsilon = CEEpsRule++instance (EpsProductionRule p) => LiftableProductionRule (CombineEpsilonsRule p phi r t) where+  epsilonL v _ = CEEpsRule v++instance (TokenProductionRule p t) =>+         TokenProductionRule (CombineEpsilonsRule p phi r t) t where+  token = CERule id . token++instance (RecProductionRule p phi r) =>+         RecProductionRule (CombineEpsilonsRule p phi r t) phi r where+  ref = CERule id . ref++instance (EpsProductionRule p, LoopProductionRule p phi r) =>+         LoopProductionRule (CombineEpsilonsRule p phi r t) phi r where+  manyRef = CERule id . manyRef+  many1Ref = CERule id . many1Ref++runCERule :: (ProductionRule p, EpsProductionRule p) =>+             CombineEpsilonsRule p phi r t v -> p v+runCERule (CERule f r) = f $>> r+runCERule (CEEpsRule v) = epsilon v++-- | Combine consecutive epsilon rules in a given grammar into a single+-- epsilon rule.+combineEpsilons :: forall phi t r rr. +  GContextFreeGrammar phi t r rr ->+  GContextFreeGrammar phi t r rr+combineEpsilons gram idx = runCERule $ gram idx++-- | Combine consecutive epsilon rules in a given extended +-- grammar into a single epsilon rule.+combineEpsilonsE :: forall phi t r rr. +  GExtendedContextFreeGrammar phi t r rr ->+  GExtendedContextFreeGrammar phi t r rr+combineEpsilonsE gram idx = runCERule $ gram idx+
+ Text/GrammarCombinators/Transform/FilterDies.hs view
@@ -0,0 +1,94 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Transform.FilterDies (+  filterDies,+  filterDiesE,+  filterDiesLE+  ) where++import Text.GrammarCombinators.Base++data FilterDiesRule p (phi :: * -> *) (r :: * -> *) t v = +    FDBaseRule (p v)+  | FDDieRule++instance ProductionRule p =>+         ProductionRule (FilterDiesRule p phi r t) where+  endOfInput = FDBaseRule endOfInput+  FDDieRule >>> _ = FDDieRule+  _ >>> FDDieRule = FDDieRule+  (FDBaseRule ra) >>> (FDBaseRule rb) = FDBaseRule $ ra >>> rb+  FDDieRule ||| rb = rb+  (FDBaseRule ra) ||| fdrb =+    FDBaseRule $ case fdrb of FDDieRule -> ra+                              (FDBaseRule rb) -> ra ||| rb+  die = FDDieRule++instance (EpsProductionRule p) =>+         EpsProductionRule (FilterDiesRule p phi r t) where+  epsilon = FDBaseRule . epsilon++instance (LiftableProductionRule p) =>+         LiftableProductionRule (FilterDiesRule p phi r t) where+  epsilonL v q = FDBaseRule $ epsilonL v q++instance (TokenProductionRule p t) =>+         TokenProductionRule (FilterDiesRule p phi r t) t where+  token = FDBaseRule . token++instance (RecProductionRule p phi r) =>+         RecProductionRule (FilterDiesRule p phi r t) phi r where+  ref = FDBaseRule . ref++instance (LoopProductionRule p phi r) =>+         LoopProductionRule (FilterDiesRule p phi r t) phi r where+  manyRef = FDBaseRule . manyRef+  many1Ref = FDBaseRule . many1Ref++runFDRule :: (ProductionRule p) =>+             FilterDiesRule p phi r t v -> p v+runFDRule FDDieRule = die+runFDRule (FDBaseRule r) = r++-- | Filter dead branches from a given context-free grammar.+filterDies :: forall phi t r rr. +  GContextFreeGrammar phi t r rr ->+  GContextFreeGrammar phi t r rr+filterDies gram idx = runFDRule $ gram idx++-- | Filter dead branches from a given extended context-free grammar.+filterDiesE :: forall phi t r rr. +  GExtendedContextFreeGrammar phi t r rr ->+  GExtendedContextFreeGrammar phi t r rr+filterDiesE gram idx = runFDRule $ gram idx++-- | Filter dead branches from a given extended context-free grammar.+filterDiesLE :: forall phi t r rr. +  GLExtendedContextFreeGrammar phi t r rr ->+  GLExtendedContextFreeGrammar phi t r rr+filterDiesLE gram idx = runFDRule $ gram idx+
+ Text/GrammarCombinators/Transform/FoldLoops.hs view
@@ -0,0 +1,186 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Text.GrammarCombinators.Transform.FoldLoops (+  FLBaseIx, FLManyIx,+  Memo (FLM),+  FoldLoopsDomain (FLBase, FLMany),+  FoldLoopsValue (..),+  FoldLoopsResultValue (..),+  processFoldLoops,+  foldLoops,+  foldAndProcessLoops+  ) where++import Text.GrammarCombinators.Base++-- | A parametrised type such that 'FLBaseIx' ix represents+-- base non-terminal ix.+data FLBaseIx ix+-- | A parametrised type such that 'FLBaseIx' ix represents+-- the Kleene-'*' version of base non-terminal ix.+data FLManyIx ix ++-- | FoldLoopsDomain phi defines, for base domain phi, an+-- extended domain containing non-terminal types +-- 'FLBaseIx' ix representing base non-terminal ix, and +-- 'FLManyIx' ix representing a Kleene-* version of base+-- non-terminal ix.+data FoldLoopsDomain phi ix where+  +  FLBase :: phi ix -> FoldLoopsDomain phi (FLBaseIx ix)+  FLMany :: phi ix -> FoldLoopsDomain phi (FLManyIx ix)++instance (FoldFam phi) => FoldFam (FoldLoopsDomain phi) where+  foldFam f n =+    foldFam (f . FLMany) $+    foldFam (f . FLBase) n++instance (ShowFam phi) => ShowFam (FoldLoopsDomain phi) where+  showIdx (FLBase idx) = showIdx idx+  showIdx (FLMany idx) = showIdx idx ++ "*"++instance (EqFam phi) => EqFam (FoldLoopsDomain phi) where+  overrideIdx f (FLBase idx) v (FLBase idx') = unSubVal $ overrideIdx (MkSubVal . f . FLBase) idx (MkSubVal v) idx'+  overrideIdx f (FLMany idx) v (FLMany idx') = unSubVal $ overrideIdx (MkSubVal . f . FLMany) idx (MkSubVal v) idx'+  overrideIdx f _ _ idx = f idx++instance DomainMap (FoldLoopsDomain phi) phi FLBaseIx where+  supIx = FLBase+  subIx (FLBase idx) = idx+  +instance DomainMap (FoldLoopsDomain phi) phi FLManyIx where+  supIx = FLMany+  subIx (FLMany idx) = idx++instance (MemoFam phi) => MemoFam (FoldLoopsDomain phi) where+  data Memo (FoldLoopsDomain phi) v = FLM (Memo phi (SubVal FLBaseIx v)) (Memo phi (SubVal FLManyIx v))+  fromMemo (FLM mb _) (FLBase idx) = unSubVal $ fromMemo mb idx+  fromMemo (FLM _ mm) (FLMany idx) = unSubVal $ fromMemo mm idx +  toMemo f = FLM (toMemo $ MkSubVal . f . FLBase) (toMemo $ MkSubVal . f . FLMany)++instance Domain phi => Domain (FoldLoopsDomain phi)++-- | FoldLoopsValue defines, for a semantic value family+-- r over base domain phi, a semantic value family +-- 'FoldLoopsValue' r over domain 'FoldLoopsDomain' r, such+-- that the semantic value for base non-terminal 'FLBaseIx' +-- is a wrapped version of type r ix, and for Kleene-* non-terminal+-- 'FLManyIx' a wrapped version of type [r ix]. +data family FoldLoopsValue (r :: * -> *) ix+newtype instance FoldLoopsValue r (FLBaseIx ix) = FLBV { unFLBV :: r ix } deriving (Show)+newtype instance FoldLoopsValue r (FLManyIx ix) = FLMV { unFLMV :: [r ix] } deriving (Show)++-- | FoldLoopsResultValue defines, for semantic value families+-- r and rr over base domain phi, a semantic value family +-- 'FoldLoopsResultValue' r rr over domain 'FoldLoopsDomain' r.+-- such that the semantic value for base non-terminal 'FLBaseIx' +-- is a wrapped version of type rr ix, and for Kleene-* non-terminal+-- 'FLManyIx' a wrapped version of type [r ix]. +data family FoldLoopsResultValue (r :: * -> *) (rr :: * -> *) ix+newtype instance FoldLoopsResultValue r rr (FLBaseIx ix) = FLRBV { unFLRBV :: rr ix }+newtype instance FoldLoopsResultValue r rr (FLManyIx ix) = FLRMV { unFLRMV :: [r ix] }++data FLWrap p unused1 unused2 phi r t v where+  FLW :: p v -> FLWrap p (FoldLoopsDomain phi) (FoldLoopsValue r) phi r t v+unFLW :: FLWrap p (FoldLoopsDomain phi) (FoldLoopsValue r) phi r t v -> p v+unFLW (FLW p) = p++instance (ProductionRule p) =>+         ProductionRule (FLWrap p (FoldLoopsDomain phi) (FoldLoopsValue r) phi r t) where+  (FLW a) >>> (FLW b) = FLW $ a >>> b+  (FLW a) ||| (FLW b) = FLW $ a ||| b+  die = FLW die+  endOfInput = FLW endOfInput++instance (EpsProductionRule p) =>+         EpsProductionRule (FLWrap p (FoldLoopsDomain phi) (FoldLoopsValue r) phi r t) where+  epsilon = FLW . epsilon++instance (LiftableProductionRule p) =>+         LiftableProductionRule (FLWrap p (FoldLoopsDomain phi) (FoldLoopsValue r) phi r t) where+  epsilonL v q = FLW $ epsilonL v q++instance (TokenProductionRule p t) =>+         TokenProductionRule (FLWrap p (FoldLoopsDomain phi) (FoldLoopsValue r) phi r t) t where+  token = FLW . token++instance (RecProductionRule p (FoldLoopsDomain phi) (FoldLoopsValue r),+          ProductionRule p, EpsProductionRule p) => +         RecProductionRule (FLWrap p (FoldLoopsDomain phi) (FoldLoopsValue r) phi r t) phi r where+  ref idx = FLW $ epsilon (\(FLBV v) -> v) >>> ref (FLBase idx)++instance (ProductionRule p, EpsProductionRule p, LiftableProductionRule p,+          TokenProductionRule p t, RecProductionRule p (FoldLoopsDomain phi) (FoldLoopsValue r)) =>+          LoopProductionRule (FLWrap p (FoldLoopsDomain phi) (FoldLoopsValue r) phi r t) phi r where+  manyRef idx = FLW $ epsilon (\(FLMV lv) -> lv) >>> ref (FLMany idx)++-- | Construct a processor for a grammar transformed using the 'foldLoops' algorithm, +-- given a processor for the original grammar.+processFoldLoops :: forall phi r rr. GProcessor phi r rr -> GProcessor (FoldLoopsDomain phi) (FoldLoopsValue r) (FoldLoopsResultValue r rr)+processFoldLoops proc (FLBase (idx :: phi ix')) (FLRBV v) = FLBV $ proc idx v+processFoldLoops _ (FLMany _) (FLRMV vs) = FLMV vs++-- | Transform a given extended context-free grammar over a domain 'phi' into a standard+-- context-free grammar over the extended domain 'FoldLoopsDomain' 'phi'.+-- Calls to 'manyRef' idx are transformed into calls to 'ref' ('FLMany' idx),+-- where 'FLMany' idx is a new non-terminal representing the+-- Kleene-* version of underlying non-terminal 'idx'. Normal+-- calls to 'ref' idx are transformed into calls to 'ref' +-- ('FLBase' idx) where 'FLBase' idx represents the unmodified+-- underlying non-terminal 'idx'. The 'foldLoops' algorithm +-- constructs appropriate production rules for both types of+-- new non-terminals.+-- Values are wrapped in the 'FoldLoopsResultValue' 'r' 'rr'+-- semantic value family.+foldLoops :: +  GExtendedContextFreeGrammar phi t r rr ->+  GContextFreeGrammar (FoldLoopsDomain phi) t (FoldLoopsValue r) (FoldLoopsResultValue r rr)+foldLoops bgram (FLBase (idx :: phi ix)) = +  epsilon FLRBV >>> unFLW (bgram idx)+foldLoops _ (FLMany idx) = +      epsilon (\(FLBV v) (FLMV vs) -> FLRMV (v:vs)) >>> +      ref (FLBase idx) >>> ref (FLMany idx) +  ||| epsilon (FLRMV [])+    +-- | Transform a given processing extended context-free +-- grammar over a domain 'phi' into a standard context-free+-- grammar over the extended domain 'FoldLoopsDomain phi'.+-- Completely similar to 'foldLoops', but wraps values in the+-- 'FoldLoopsValue' 'r' semantic value family.+foldAndProcessLoops ::+  forall phi t r . Token t =>+  ProcessingExtendedContextFreeGrammar phi t r->+  ProcessingContextFreeGrammar (FoldLoopsDomain phi) t (FoldLoopsValue r)+foldAndProcessLoops gram = +  let+    loopsproc = processFoldLoops identityProcessor+  in applyProcessor (foldLoops gram) loopsproc
+ Text/GrammarCombinators/Transform/LeftCorner.hs view
@@ -0,0 +1,263 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}++module Text.GrammarCombinators.Transform.LeftCorner (+  LCBaseIx, LCNTMinNTIx, LCNTMinTIx,+  LCDomain (LCBase, LCNTMinNT, LCNTMinT),+  LCValue( LCBV, LCNTMinNTV, LCNTMinTV ),+  transformLeftCorner,+  transformLeftCornerE+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Utils.CalcFirst++import Data.Map (Map, (!))+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Enumerable+import Control.Applicative ((<*>))++-- NOTES:+-- recursion only through list of left-corner terminals, so we can handle non-processing CFG's?++data LCBaseIx ix+data LCNTMinNTIx ix' ix+data LCNTMinTIx t ix++-- | 'LCDomain' defines, for a base domain phi an extended+-- domain containing the non-terminals used by the left-+-- corner transform.+data LCDomain phi t ix where+  LCBase :: phi ix -> LCDomain phi t (LCBaseIx ix)+  LCNTMinNT :: phi ix' -> phi ix -> LCDomain phi t (LCNTMinNTIx ix' ix)+  LCNTMinT :: t -> phi ix -> LCDomain phi t (LCNTMinTIx t ix)++instance (ShowFam phi, Show t) => ShowFam (LCDomain phi t) where+  showIdx (LCBase idx) = showIdx idx+  showIdx (LCNTMinNT idx' idx) = showIdx idx ++ "-" ++ showIdx idx'+  showIdx (LCNTMinT tt idx) = showIdx idx ++ "-" ++ show tt++instance (Token t, FoldFam phi) => FoldFam (LCDomain phi t) where+  foldFam (f :: forall ix. LCDomain phi t ix -> b -> b) n =+    let n' = foldFam (f . LCBase) n+        f' idx = foldFam (f . (LCNTMinNT `flip` idx))+        n'' = foldFam f' n'+        f'' tt = foldFam (f . LCNTMinT tt)+        n''' = foldr f'' n'' enumerate+    in n''' ++newtype WrapLCNTMinNTMemo phi r ix' =+  WLCNTMNTM { unWLCNTMNT :: Memo phi (SubVal (LCNTMinNTIx ix') r) }++instance (MemoFam phi, Token t) =>+         MemoFam (LCDomain phi t) where+  data Memo (LCDomain phi t) r =+    MemoLCD (Memo phi (SubVal LCBaseIx r))+            (Memo phi (WrapLCNTMinNTMemo phi r))+            (Map t (Memo phi (SubVal (LCNTMinTIx t) r)))+  toMemo f = MemoLCD (toMemo (MkSubVal . f . LCBase))+                     (toMemo (WLCNTMNTM . (\idx' -> toMemo (MkSubVal . f . LCNTMinNT idx'))))+                     (Map.fromList (map (\tt -> (tt, toMemo (MkSubVal . f . LCNTMinT tt))) enumerate))+  fromMemo (MemoLCD mb _ _) (LCBase idx) = unSubVal $ fromMemo mb idx+  fromMemo (MemoLCD _ mnmn _) (LCNTMinNT idx' idx) =+    unSubVal $ fromMemo (unWLCNTMNT $ fromMemo mnmn idx') idx+  fromMemo (MemoLCD _ _ mnmt) (LCNTMinT tt idx) =+    unSubVal $ fromMemo (mnmt ! tt) idx++instance (Domain phi, Token t) => Domain (LCDomain phi t)++newtype WrapFSect phi r ix = WFS {+  unWFS :: forall ix'. phi ix' -> r (LCNTMinNTIx ix ix')+  }++instance (EqFam phi, Token t) => EqFam (LCDomain phi t) where+  overrideIdx f (LCBase idx) v (LCBase idx') =+    unSubVal $ overrideIdx (MkSubVal . f . LCBase) idx (MkSubVal v) idx'+  overrideIdx (f :: forall ix. LCDomain phi t ix -> r ix) (LCNTMinNT idx idxm) v (LCNTMinNT idx' idxm') =+    let+      fc :: forall ix ixm. phi ix -> phi ixm -> r (LCNTMinNTIx ix ixm)+      fc idx'' idxm'' = f $ LCNTMinNT idx'' idxm''+      fsect' idxm'' = unSubVal $ overrideIdx (MkSubVal . fc idx) idxm (MkSubVal v) idxm''+      fc' :: forall ix ixm. phi ix -> phi ixm -> r (LCNTMinNTIx ix ixm)+      fc' idxm'' = unWFS $ overrideIdx (\idx'' -> WFS $ fc idx'') idx (WFS fsect') idxm''+    in fc' idx' idxm'+  overrideIdx f (LCNTMinT tt idx) v (LCNTMinT tt' idx') =+    if tt == tt'+    then unSubVal $ overrideIdx (MkSubVal . f . LCNTMinT tt) idx (MkSubVal v) idx'+    else f (LCNTMinT tt' idx')+  overrideIdx f _ _ idx' = f idx'++instance DomainMap (LCDomain phi t) phi LCBaseIx where+  supIx = LCBase+  subIx (LCBase idx) = idx+  +data family LCValue (r :: * -> *) t ix+data instance LCValue r t (LCBaseIx ix) = LCBV { unLCBV :: r ix } deriving (Show)+data instance LCValue r t (LCNTMinNTIx ix' ix) = LCNTMinNTV { unLCNTMinNTV :: r ix' -> r ix}+data instance LCValue r t (LCNTMinTIx t ix) = LCNTMinTV { unLCNTMinTV :: ConcreteToken t -> r ix }++data TransformLCRule p (unused1 :: * -> *) (unused2 :: * -> *) (phi :: * -> *) (r :: * -> *) t v = +  MkTLCIR {+    tlcEmpty :: Maybe v,+    tlcFull :: p v,+    tlcNTMinNT :: forall ix'. phi ix' -> p (r ix' -> v),+    tlcNTMinT :: t -> p (ConcreteToken t -> v)+    }++instance (ProductionRule p,+          EpsProductionRule p,+          RecProductionRule p (LCDomain phi t) (LCValue r t)) =>+         ProductionRule (TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t) where+  ra >>> rb = +    let+      es = tlcEmpty ra <*> tlcEmpty rb+      emptyA = maybe die epsilon $ tlcEmpty ra+      f = tlcFull ra >>> tlcFull rb+      rNTMinNT idx' =   flip $>> tlcNTMinNT ra idx' >>> tlcFull rb+                    ||| (.) $>> emptyA >>> tlcNTMinNT rb idx'+      rNTMinT tt =   flip $>> tlcNTMinT ra tt >>> tlcFull rb+                 ||| (.) $>> emptyA >>> tlcNTMinT rb tt+    in MkTLCIR es f rNTMinNT rNTMinT +  ra ||| rb =+    let+      es = case (tlcEmpty ra, tlcEmpty rb) of+        (Just _, Just _) -> error "Ambiguous: empty disjunction"+        (Just va, Nothing) -> Just va+        (Nothing, Just vb) -> Just vb+        (Nothing, Nothing) -> Nothing+      f = tlcFull ra ||| tlcFull rb+      rNTMinNT idx' = tlcNTMinNT ra idx' ||| tlcNTMinNT rb idx'+      rNTMinT tt = tlcNTMinT ra tt ||| tlcNTMinT rb tt+    in MkTLCIR es f rNTMinNT rNTMinT +  endOfInput = MkTLCIR Nothing endOfInput (const die) (const die)+  die = MkTLCIR Nothing die (const die) (const die) ++instance (ProductionRule p,+          EpsProductionRule p,+          RecProductionRule p (LCDomain phi t) (LCValue r t)) =>+         EpsProductionRule (TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t) where+  epsilon v = MkTLCIR (Just v) (epsilon v) (const die) (const die) ++instance (ProductionRule p,+          EpsProductionRule p,+          RecProductionRule p (LCDomain phi t) (LCValue r t)) =>+         LiftableProductionRule (TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t) where+  epsilonL v _ = epsilon v++instance (Token t, TokenProductionRule p t, ProductionRule p,+          LiftableProductionRule p,+          RecProductionRule p (LCDomain phi t) (LCValue r t)) =>+         TokenProductionRule (TransformLCRule p unused1 unused2 phi r t) t where+  token tt = +    let rNTMinT tt' = if tt == tt' then epsilonL id [|id|] else die+    in MkTLCIR Nothing (token tt) (const die) rNTMinT ++newtype WrapNTMinNTP p r ix surrIx =+  WNTMinNTP { unWNTMinNTP :: p (r surrIx -> r ix) }++instance (ProductionRule p, EqFam phi,+          EpsProductionRule p,+          RecProductionRule p (LCDomain phi t) (LCValue r t)) => +         RecProductionRule (TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t) phi r where+  ref idx = +    let f = unLCBV $>> ref (LCBase idx)+        rNTMinNT idxm = unWNTMinNTP $ overrideIdx (\_ -> WNTMinNTP die) idx (WNTMinNTP $ epsilon id) idxm+    in MkTLCIR Nothing f rNTMinNT (const die) ++newtype WrapNTMinNTPs p r ix surrIx =+  WNTMinNTPs { unWNTMinNTPs :: p (r surrIx -> [r ix]) }+instance (EqFam phi,+          EpsProductionRule p,+          LoopProductionRule p (LCDomain phi t) (LCValue r t)) => +         LoopProductionRule (TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t) phi r where+  manyRef (idx :: phi ix) =+    let f = map unLCBV $>> manyRef (LCBase idx)+        rNTMinNTIdx = flip (:) $>> (map unLCBV $>> manyRef (LCBase idx))+        rNTMinNT idxm = unWNTMinNTPs $ overrideIdx (\_ -> WNTMinNTPs die) idx (WNTMinNTPs rNTMinNTIdx) idxm+    in MkTLCIR Nothing f rNTMinNT (const die)+  many1Ref (idx :: phi ix) =+    let f = map unLCBV $>> many1Ref (LCBase idx)+        rNTMinNTIdx = flip (:) $>> (map unLCBV $>> manyRef (LCBase idx))+        rNTMinNT idxm = unWNTMinNTPs $ overrideIdx (\_ -> WNTMinNTPs die) idx (WNTMinNTPs rNTMinNTIdx) idxm+    in MkTLCIR Nothing f rNTMinNT (const die) ++transformLeftCorner' ::+  forall p phi r t ix.+  (Domain phi, Token t, TokenProductionRule p t,+   ProductionRule p,+   EpsProductionRule p,+   RecProductionRule p (LCDomain phi t) (LCValue r t)) =>+  (forall ix'. phi ix' ->+   TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t (r ix')) ->+  (forall ix'. phi ix' -> FirstSet t) ->+  LCDomain phi t ix ->+  p (LCValue r t ix)+transformLeftCorner' _ cfs (LCBase idx) = +  let FS fs _ _ = cfs idx -- TODO: what if it can be empty?+      ruleT tt = flip ($) $>> token tt >>> (unLCNTMinTV $>> ref (LCNTMinT tt idx))+      ruleTs = LCBV $>> Set.fold ((|||) . ruleT) die fs+  in ruleTs +transformLeftCorner' bgram _ (LCNTMinT tt idx) = +  let+    bMinT idxB = flip (.) $>> tlcNTMinT (bgram idxB) tt >>> (unLCNTMinNTV $>> ref (LCNTMinNT idxB idx))+    bMinTs = foldFam ((|||) . bMinT) die+  in     LCNTMinTV $>> bMinTs+     ||| LCNTMinTV $>> tlcNTMinT (bgram idx) tt+transformLeftCorner' bgram _ (LCNTMinNT idxm idx) = +  let+    cMinB idxC = LCNTMinNTV $>> (flip (.) $>> tlcNTMinNT (bgram idxC) idxm >>> follow idxC)+    baseFollow idxC = unLCNTMinNTV $>> ref (LCNTMinNT idxC idx)+    follow idxC = unWNTMinNTP $ overrideIdx (WNTMinNTP . baseFollow) idx (WNTMinNTP $ baseFollow idx ||| epsilon id) idxC+  in -- flip (|||) produces alternatives in a better order, typically+   foldFam (flip (|||) . cMinB) die ++-- | Apply the left-corner transform to a given grammar, removing direct and indirect left recursion.+-- +-- Note that the new domain will contain O(n*t + n^2)+-- non-terminals where n is the amount of non-terminals and t is the+-- number of tokens, so when using this transformation, it can be beneficial to+-- use a token type with a more limited amount of token values than 'Char', at+-- least if you will use algorithms that fold over the full new grammar's domain +-- (e.g. 'printGrammar' does, 'printReachableGrammar' doesn't).+transformLeftCorner ::+  (Domain phi, Token t) =>+  ProcessingContextFreeGrammar phi t r ->+  ProcessingContextFreeGrammar (LCDomain phi t) t (LCValue r t)+transformLeftCorner gram idx = transformLeftCorner' gram (calcFirst gram) idx ++-- | Apply the left-corner transform to a given extended grammar, removing direct and indirect left recursion.+transformLeftCornerE ::+  forall phi t r. (Domain phi, Token t) =>+  ProcessingExtendedContextFreeGrammar phi t r ->+  ProcessingExtendedContextFreeGrammar (LCDomain phi t) t (LCValue r t)+transformLeftCornerE gram idx = transformLeftCorner' gram (calcFirst gram) idx
+ Text/GrammarCombinators/Transform/OptimizeGrammar.hs view
@@ -0,0 +1,39 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}++module Text.GrammarCombinators.Transform.OptimizeGrammar where++-- just a combination of some transforms (in a correct order)+-- TODO: check order++import Text.GrammarCombinators.Base++import Text.GrammarCombinators.Transform.CombineEpsilons+import Text.GrammarCombinators.Transform.FilterDies+import Text.GrammarCombinators.Transform.UnfoldDead+import Text.GrammarCombinators.Transform.UniformPaull+import Text.GrammarCombinators.Transform.UnfoldChainNTs++optimizeGrammarE :: (Token t, Domain phi) => +  ProcessingExtendedContextFreeGrammar phi t r ->+  ProcessingExtendedContextFreeGrammar (UPDomain phi) t (UPValue r)+optimizeGrammarE g = combineEpsilonsE (unfoldChainNTsE (filterDiesE (unfoldDeadE (transformUniformPaullE g))))
+ Text/GrammarCombinators/Transform/UnfoldChainNTs.hs view
@@ -0,0 +1,107 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Transform.UnfoldChainNTs (+  unfoldChainNTs,+  unfoldChainNTsE+  ) where++import Text.GrammarCombinators.Base++import Text.GrammarCombinators.Utils.IsChainNT+import Text.GrammarCombinators.Transform.UnfoldRecursion +import Text.GrammarCombinators.Transform.UnfoldLoops++-- | Unfold chain non-terminals in a given context-+-- free grammar.+-- A chain non-terminal is a terminal such that its+-- production rule is a numer of epsilons followed by a +-- single normal reference to another non-terminal.+unfoldChainNTs :: forall phi r t. (EqFam phi) => +  ProcessingContextFreeGrammar phi r t -> +  ProcessingContextFreeGrammar phi r t +unfoldChainNTs gram idx =+  let +    gram' :: ProcessingContextFreeGrammar phi r t+    gram' idx' = if isChainNT (unfoldChainNTs gram) idx'+                then unfoldChainNTs gram idx'+                else ref idx'+  in unfoldRule (gram idx) gram'++data RuleToManyWrapper p (phi :: * -> *) (r :: * -> *) t v =+  RTMEps v |+  RTMW { ruleToManyRule :: p [v], +         ruleToMany1Rule :: p [v] }++instance (ProductionRule p, EpsProductionRule p) =>+         ProductionRule (RuleToManyWrapper p phi r t) where+  (RTMEps va) >>> (RTMEps vb) = RTMEps $ va vb+  (RTMEps va) >>> (RTMW rmb rm1b) = RTMW (map va $>> rmb) (map va $>> rm1b)+  (RTMW rma rm1a) >>> (RTMEps vb) = RTMW (map ($ vb) $>> rma) (map ($ vb) $>> rm1a)+  (RTMW _ _ ) >>> (RTMW _ _) = RTMW die die+  _ ||| _ = RTMW die die+  die = RTMW die die+  endOfInput = RTMW die die++instance (ProductionRule p, EpsProductionRule p) => EpsProductionRule (RuleToManyWrapper p phi r t) where+  epsilon = RTMEps++instance (ProductionRule p, EpsProductionRule p) => LiftableProductionRule (RuleToManyWrapper p phi r t) where+  epsilonL v _ = RTMEps v++instance (ProductionRule p) => TokenProductionRule (RuleToManyWrapper p phi r t) t where+  token _ = RTMW die die++instance (LoopProductionRule p phi r) =>+         RecProductionRule (RuleToManyWrapper p phi r t) phi r where+  ref idx = RTMW (manyRef idx) (many1Ref idx)++instance (ProductionRule p, EpsProductionRule p, LoopProductionRule p phi r) =>+         LoopProductionRule (RuleToManyWrapper p phi r t) phi r where+  manyRef _ = RTMW die die+  many1Ref _ = RTMW die die++-- | Unfold chain non-terminals in a given extended +-- context-free grammar.+-- A chain non-terminal is a terminal such that its+-- production rule is a numer of epsilons followed by a +-- single normal reference to another non-terminal.+unfoldChainNTsE :: forall phi r t. (EqFam phi) => +  ProcessingExtendedContextFreeGrammar phi r t -> +  ProcessingExtendedContextFreeGrammar phi r t +unfoldChainNTsE gram idx =+  let gramm' idx' = if isChainNT (unfoldChainNTsE gram) idx'+                   then ruleToManyRule (unfoldChainNTsE gram idx')+                   else manyRef idx'+      gramm1' idx' = if isChainNT (unfoldChainNTsE gram) idx'+                    then ruleToMany1Rule (unfoldChainNTsE gram idx')+                    else many1Ref idx'+      gram' :: ProcessingExtendedContextFreeGrammar phi r t+      gram' idx' = if isChainNT (unfoldChainNTsE gram) idx'+                  then unfoldChainNTsE gram idx'+                  else ref idx'+  in replaceLoopsRule (unfoldRuleE (gram idx) gram') gramm' gramm1'++-- TODO: unfold chain rules -> useful?
+ Text/GrammarCombinators/Transform/UnfoldDead.hs view
@@ -0,0 +1,99 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}++module Text.GrammarCombinators.Transform.UnfoldDead (+  unfoldDead,+  unfoldDeadE,+  unfoldDeadLE+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Utils.IsDead ++newtype UnfoldDeadRule p (phi :: * -> *) (r :: * -> *) t v = +    UDRule { unUDRule :: (forall ix. phi ix -> Bool) -> p v }++instance (ProductionRule p) =>+         ProductionRule (UnfoldDeadRule p phi r t) where+  a >>> b = UDRule $ \g -> unUDRule a g >>> unUDRule b g+  a ||| b = UDRule $ \g -> unUDRule a g ||| unUDRule b g+  die = UDRule $ \_ -> die+  endOfInput = UDRule $ \_ -> endOfInput++instance (EpsProductionRule p) =>+         EpsProductionRule (UnfoldDeadRule p phi r t) where+  epsilon v = UDRule $ \_ -> epsilon v++instance (LiftableProductionRule p) =>+         LiftableProductionRule (UnfoldDeadRule p phi r t) where+  epsilonL v q = UDRule $ \_ -> epsilonL v q++instance (TokenProductionRule p t) =>+         TokenProductionRule (UnfoldDeadRule p phi r t) t where+  token t = UDRule $ \_ -> token t++instance (ProductionRule p, +          RecProductionRule p phi r) =>+         RecProductionRule (UnfoldDeadRule p phi r t) phi r where+  ref idx = UDRule $ \g -> if g idx then die else ref idx++instance (ProductionRule p, +          LiftableProductionRule p, +          LoopProductionRule p phi r) =>+         LoopProductionRule (UnfoldDeadRule p phi r t) phi r where+  manyRef idx = UDRule $ \g -> if g idx then epsilonL [] [| [] |] else manyRef idx +  many1Ref idx = UDRule $ \g -> if g idx then die else many1Ref idx ++-- | Unfold dead non-terminals in a given extended context-+-- free grammar, such+-- that the unfolded references can be filtered with the+-- 'filterDies' algorithm. This uses the 'isDead' algorithm+-- to detect dead non-terminals.+unfoldDeadE :: (EqFam phi, FoldFam phi, MemoFam phi) => +  GExtendedContextFreeGrammar phi r t rr -> +  GExtendedContextFreeGrammar phi r t rr+unfoldDeadE gram idx = unUDRule (gram idx) $ isDead gram++-- | Unfold dead non-terminals in a given extended liftable context-+-- free grammar, such+-- that the unfolded references can be filtered with the+-- 'filterDies' algorithm. This uses the 'isDead' algorithm+-- to detect dead non-terminals.+unfoldDeadLE :: (EqFam phi, FoldFam phi, MemoFam phi) => +  GLExtendedContextFreeGrammar phi r t rr -> +  GLExtendedContextFreeGrammar phi r t rr+unfoldDeadLE gram idx = unUDRule (gram idx) $ isDead gram++-- | Unfold dead non-terminals in a given context-+-- free grammar, such+-- that the unfolded references can be filtered with the+-- 'filterDies' algorithm. This uses the 'isDead' algorithm+-- to detect dead non-terminals.+unfoldDead :: (EqFam phi, FoldFam phi, MemoFam phi) => +  GContextFreeGrammar phi r t rr -> +  GContextFreeGrammar phi r t rr+unfoldDead gram idx = unUDRule (gram idx) $ isDead gram
+ Text/GrammarCombinators/Transform/UnfoldLoops.hs view
@@ -0,0 +1,105 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Transform.UnfoldLoops (+  unfoldLoops,+  unfoldLoopsRule,+  replaceLoopsRule+  ) where++import Text.GrammarCombinators.Base++newtype UnfoldLoopsWrapper p (phi :: * -> *) ixT (r :: * -> *) t v = ULW {+  runULW :: (forall ix. phi ix -> p [r ix]) -> (forall ix. phi ix -> p [r ix]) -> p v+  }++instance (ProductionRule p) =>+         ProductionRule (UnfoldLoopsWrapper p phi ixT r t) where+  ra >>> rb = ULW $ \gm gm1 -> runULW ra gm gm1 >>> runULW rb gm gm1+  ra ||| rb = ULW $ \gm gm1 -> runULW ra gm gm1 ||| runULW rb gm gm1+  die = ULW $ \_ _ -> die+  endOfInput = ULW $ \_ _ -> endOfInput++instance (LiftableProductionRule p) =>+         LiftableProductionRule (UnfoldLoopsWrapper p phi ixT r t) where+  epsilonL v q = ULW $ \_ _ -> epsilonL v q++instance (EpsProductionRule p) =>+         EpsProductionRule (UnfoldLoopsWrapper p phi ixT r t) where+  epsilon v = ULW $ \_ _ -> epsilon v++-- no newtype deriving for multi param type classes?+instance (TokenProductionRule p t) =>+         TokenProductionRule (UnfoldLoopsWrapper p phi ixT r t) t where+  token t = ULW $ \_ _ -> token t++instance (RecProductionRule p phi r) =>+         RecProductionRule (UnfoldLoopsWrapper p phi ixT r t) phi r where+  ref idx = ULW $ \_ _ -> ref idx++instance (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r) =>+         LoopProductionRule (UnfoldLoopsWrapper p phi ixT r t) phi r where+  manyRef idx = ULW $ \gm _ -> gm idx+  many1Ref idx = ULW $ \_ gm1 -> gm1 idx++-- | Unfold loops in a given grammar, replacing calls to+-- 'manyRef' idx by 'manyInf' ('ref' idx) and likewise+-- for 'many1Ref'+unfoldLoops :: +  GExtendedContextFreeGrammar phi t r rr ->+  GContextFreeGrammar phi t r rr+unfoldLoops gram idx = +  unfoldLoopsRule (gram idx) ++-- | Unfold loops in a given rule, replacing calls to+-- 'manyRef' idx by 'manyInf' ('ref' idx) and likewise+-- for 'many1Ref'+unfoldLoopsRule :: +  ExtendedContextFreeRule phi r t v ->+  ContextFreeRule phi r t v+unfoldLoopsRule r = +  let+    manyGram idx = manyInf $ ref idx+    oneOrMoreGram idx = (:) $>> ref idx >>> manyGram idx+  in replaceLoopsRule r manyGram oneOrMoreGram++-- | Replace loops in a given rule by rules provided+-- in two provided sets of rules, replacing calls to+-- 'manyRef' by the corresponding rule from the first+-- set, and calls to 'manyRef' by the corresponding rule+-- from the second set. You likely don't need this+-- and should be looking at 'unfoldLoops' or +-- 'unfoldLoopsRule' instead.+replaceLoopsRule :: +  (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t) =>+  ExtendedContextFreeRule phi r t v ->+  (forall ix. phi ix -> p [r ix]) ->+  (forall ix. phi ix -> p [r ix]) ->+  p v+replaceLoopsRule r = +  runULW r +
+ Text/GrammarCombinators/Transform/UnfoldRecursion.hs view
@@ -0,0 +1,189 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Transform.UnfoldRecursion (+  UnfoldDepth,+  unfoldRecursion,+  unfoldRecursionE,+  selectNothing,+  selectAllOnce,+  selectNT,+  modifyUnfoldDepth,+  unfoldSelective,+  unfoldSelectiveE,+  unfoldRule,+  unfoldRuleE+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Transform.UnfoldLoops++data RPWRule p phi ixT r t v =+  RPWRule { unRPWRule :: (forall ix. phi ix -> p (r ix)) -> p v }++instance (ProductionRule p) =>+         ProductionRule (RPWRule p phi ixT r t) where+  a >>> b = RPWRule $ \g -> unRPWRule a g >>> unRPWRule b g+  a ||| b = RPWRule $ \g -> unRPWRule a g ||| unRPWRule b g+  die = RPWRule $ const die+  endOfInput = RPWRule $ const endOfInput++instance (LiftableProductionRule p) =>+         LiftableProductionRule (RPWRule p phi ixT r t) where+  epsilonL v q = RPWRule $ \_ -> epsilonL v q++instance (EpsProductionRule p) =>+         EpsProductionRule (RPWRule p phi ixT r t) where+  epsilon v = RPWRule $ \_ -> epsilon v++instance (TokenProductionRule p t) =>+         TokenProductionRule (RPWRule p phi ixT r t) t where+  token c = RPWRule $ \_ -> token c++instance (ProductionRule p) =>+         RecProductionRule (RPWRule p phi ixT r t) phi r where+  ref idx = RPWRule $ \g -> g idx++instance (LoopProductionRule p phi r) =>+         LoopProductionRule (RPWRule p phi ixT r t) phi r where+  -- we don't unfold loops, use unfoldLoops for that...+  manyRef idx = RPWRule $ \_ -> manyRef idx +  many1Ref idx = RPWRule $ \_ -> many1Ref idx ++-- | Unfold recursion in a given contextx-free grammar, replacing+-- calls to+-- 'ref' idx with the non-terminal's production rule. This produces+-- production rules similar to those in traditional parser combinator+-- libraries.+unfoldRecursion ::+  ProcessingContextFreeGrammar phi t r ->+  ProcessingRegularGrammar phi t r+unfoldRecursion gram idx =+  unRPWRule (gram idx) $ unfoldRecursion gram++-- | Unfold recursion in a given extended context-free grammar,+-- replacing calls to+-- 'ref' idx with the non-terminal's production rule. This produces+-- production rules similar to those in traditional parser combinator+-- libraries.+unfoldRecursionE :: +  ProcessingExtendedContextFreeGrammar phi t r ->+  ProcessingRegularGrammar phi t r+unfoldRecursionE gram = unfoldRecursion (unfoldLoops gram) ++-- instance (ProductionRule p) => SuperProductionRule (RPWRule p) where+--   subref subgram idxb = rpwSubRef (subgram idxb) idxb +  +-- rpwSubRef :: forall p phi phi' supIxT ixT r ix t .+--              (DomainEmbedding phi phi' supIxT, HFunctor phi (PF phi), ProductionRule p) =>+--              RPWRule p phi' (IxMapSeq ixT supIxT) (SubVal supIxT r) t (PF phi' (SubVal supIxT r) ix) ->+--              phi' ix -> phi (supIxT ix) ->+--              RPWRule p phi ixT r t (PF phi r (supIxT ix)) +-- rpwSubRef (RPWRule subintrule) idxb idx = RPWRule $ \outgram ->+--   let+--     restrictedGrammar :: forall ix'. phi' ix' -> p ((SubVal supIxT r) ix')+--     restrictedGrammar idx' = epsilon MkSubVal >>> outgram (supIx idx')+--     presult' :: p (PF phi' (SubVal supIxT r) ix)+--     presult' = subintrule restrictedGrammar+--   in epsilon (supPF idxb idx) >>> presult'++-- | A value of type UnfoldDepth defines for each non-terminal in a+-- grammar how many times it should be unfolded by the 'unfoldSelective'+-- or 'unfoldSelectiveE' algorithms.+type UnfoldDepth phi = forall ix. phi ix -> Integer++-- | A value of type 'UnfoldDepth' phi indicating nothing should be+-- unfolded at all. This can be used as a start value and then further+-- modified with the 'selectNT' function.+selectNothing :: UnfoldDepth phi+selectNothing _ = 0++-- | A value of type 'UnfoldDepth' phi indicating every non-terminal+-- should be unfolded once.+selectAllOnce :: UnfoldDepth phi+selectAllOnce _ = 1++-- | A function modifying a given 'UnfoldDepth' phi by applying a given+-- function to the depth for a given non-terminal.+modifyUnfoldDepth :: (EqFam phi) => UnfoldDepth phi -> (Integer -> Integer) -> phi ix -> UnfoldDepth phi+modifyUnfoldDepth base f idx = overrideIdxK base idx $ f $ base idx++-- | A function modifying a given 'UnfoldDepth' phi by increasing +-- the depth for a given non-terminal by 1.+selectNT :: (EqFam phi) => UnfoldDepth phi -> phi ix -> UnfoldDepth phi+selectNT base = modifyUnfoldDepth base (+1) ++type RPWGrammar p phi ixT r v t =+  forall ix. phi ix -> RPWRule p phi ixT r t (v ix)++unfoldSelective' :: (EqFam phi, RecProductionRule p phi r) =>+  UnfoldDepth phi ->+  RPWGrammar p phi ixT r r t ->+  (forall ix. phi ix -> p (r ix))+unfoldSelective' sel gram idx =+  let+    rg idx' = if sel idx' > 0+              then unfoldSelective' (modifyUnfoldDepth sel (flip (-) 1) idx) gram idx'+             else ref idx'+  in unRPWRule (gram idx) rg++-- | Selectively unfold a given context-free grammar according to a +-- given 'UnfoldDepth'.+unfoldSelective :: (EqFam phi) =>+  UnfoldDepth phi ->+  ProcessingContextFreeGrammar phi t r ->+  ProcessingContextFreeGrammar phi t r+unfoldSelective sel gram idx = unfoldSelective' sel gram idx++-- | Selectively unfold a given extended context-free grammar+-- according to a given 'UnfoldDepth'.+unfoldSelectiveE :: (EqFam phi) =>+  UnfoldDepth phi ->+  ProcessingExtendedContextFreeGrammar phi t r ->+  ProcessingExtendedContextFreeGrammar phi t r+unfoldSelectiveE sel gram idx =+  let+    rg idx' = if sel idx' > 0+             then unfoldSelective' (modifyUnfoldDepth sel (flip (-) 1) idx') gram idx'+             else ref idx'+  in unRPWRule (gram idx) rg++-- | Unfold a given context-free rule by replacing all references to+-- non-terminals with the production rule for that non-terminal in +-- a given processing context-free grammar.+unfoldRule :: ContextFreeRule phi r t v -> +              ProcessingContextFreeGrammar phi t r ->+              ContextFreeRule phi r t v+unfoldRule r g = unRPWRule r g++-- | Unfold a given extended context-free rule by replacing all+-- references to+-- non-terminals with the production rule for that non-terminal in +-- a given processing extended context-free grammar.+unfoldRuleE :: ExtendedContextFreeRule phi r t v -> +              ProcessingExtendedContextFreeGrammar phi t r ->+              ExtendedContextFreeRule phi r t v+unfoldRuleE r g = unRPWRule r g
+ Text/GrammarCombinators/Transform/UniformPaull.hs view
@@ -0,0 +1,317 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}++module Text.GrammarCombinators.Transform.UniformPaull (+    UPDomain ( UPBase, UPHead, UPTail )+  , UPBaseIx, UPHeadIx, UPTailIx+  , UPValue ( UPBV, UPHV, UPTV )+  , unUPBV, unUPHV, unUPTV+  , transformUniformPaull+  , transformUniformPaullE+  , transformUniformPaullLE+  ) where++import Text.GrammarCombinators.Base++import Control.Monad (ap, liftM2)++import Data.Maybe (isJust, fromMaybe)++import Language.Haskell.TH.Syntax++data UPBaseIx ix+data UPHeadIx ix+data UPTailIx ix ++data UPDomain phi ix where+  UPBase :: phi ix -> UPDomain phi (UPBaseIx ix)+  UPHead :: phi ix -> UPDomain phi (UPHeadIx ix)+  UPTail :: phi ix -> UPDomain phi (UPTailIx ix)++instance (FoldFam phi) => FoldFam (UPDomain phi) where+  foldFam (f :: forall ix. UPDomain phi ix -> b -> b) =+    foldFam (\idx -> f (UPBase idx) . f (UPHead idx) . f (UPTail idx))++instance (ShowFam phi) => ShowFam (UPDomain phi) where+  showIdx (UPBase idx) = showIdx idx+  showIdx (UPHead idx) = showIdx idx ++ "_head"+  showIdx (UPTail idx) = showIdx idx ++ "_tail"++instance (LiftFam phi) => LiftFam (UPDomain phi) where+  liftIdxE (UPBase idx) = AppE (ConE 'UPBase) $ liftIdxE idx+  liftIdxE (UPHead idx) = AppE (ConE 'UPHead) $ liftIdxE idx+  liftIdxE (UPTail idx) = AppE (ConE 'UPTail) $ liftIdxE idx+  liftIdxP (UPBase idx) = ConP 'UPBase [liftIdxP idx]+  liftIdxP (UPHead idx) = ConP 'UPHead [liftIdxP idx]+  liftIdxP (UPTail idx) = ConP 'UPTail [liftIdxP idx]++instance (EqFam phi) => EqFam (UPDomain phi) where+  overrideIdx f (UPBase idx) v (UPBase idx') =+    unSubVal $ overrideIdx (MkSubVal . f . UPBase) idx (MkSubVal v) idx'+  overrideIdx f (UPHead idx) v (UPHead idx') =+    unSubVal $ overrideIdx (MkSubVal . f . UPHead) idx (MkSubVal v) idx'+  overrideIdx f (UPTail idx) v (UPTail idx') =+    unSubVal $ overrideIdx (MkSubVal . f . UPTail) idx (MkSubVal v) idx'+  overrideIdx f _ _ idx' = f idx'++instance DomainMap (UPDomain phi) phi UPBaseIx where+  supIx = UPBase+  subIx (UPBase idx) = idx+  +instance DomainMap (UPDomain phi) phi UPHeadIx where+  supIx = UPHead+  subIx (UPHead idx) = idx++instance DomainMap (UPDomain phi) phi UPTailIx where+  supIx = UPTail+  subIx (UPTail idx) = idx++instance (MemoFam phi) => MemoFam (UPDomain phi) where+  data Memo (UPDomain phi) v = UPMemo (Memo phi (SubVal UPBaseIx v)) (Memo phi (SubVal UPHeadIx v)) (Memo phi (SubVal UPTailIx v)) +  fromMemo (UPMemo mb _ _) (UPBase idx) = unSubVal $ fromMemo mb idx+  fromMemo (UPMemo _ mh _) (UPHead idx) = unSubVal $ fromMemo mh idx+  fromMemo (UPMemo _ _ mt) (UPTail idx) = unSubVal $ fromMemo mt idx +  toMemo f = UPMemo (toMemo $ MkSubVal . f . UPBase) (toMemo $ MkSubVal . f . UPHead) (toMemo $ MkSubVal . f . UPTail)++instance Domain phi => Domain (UPDomain phi)++data family UPValue (r :: * -> *) ix+data instance UPValue r (UPBaseIx ix) = UPBV { unUPBV :: r ix } deriving (Show)+data instance UPValue r (UPHeadIx ix) = UPHV { unUPHV :: r ix } deriving (Show)+data instance UPValue r (UPTailIx ix) = UPTV { unUPTV :: r ix -> r ix }++data TransformUPIntRule p surrIx (phi :: * -> *) (r :: * -> *) v = +  MkTUPIR {+    tlclwRecursionLimitActive :: forall ix. phi ix -> Bool,+    tlclwEmpty :: forall ix. phi ix -> Maybe (p v),+    tlclwHead :: forall ix. phi ix -> p v,+    tlclwTail :: phi surrIx -> [(Bool, p (r surrIx -> v))],+    tlclwFull :: p v+    }++newtype TransformUPWrapper p surrIx unused1 unused2 (phi :: * -> *) ixT (r :: * -> *) t v =+  MkTUPW {+    tUPRuleForGrammar ::+       TransformUPGrammar p surrIx phi ixT r t ->+       TransformUPIntRule p surrIx phi r v+    }++type TransformUPGrammar p surrIx phi ixT r t =+  forall ix. phi ix ->+  TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t (r ix)++mkSimpleTUPW :: (ProductionRule p) => p v ->+                 TransformUPWrapper p surrIx unused1 unused2 phi ixT r t v+mkSimpleTUPW r =+  MkTUPW $ \_ -> MkTUPIR (const False) (const Nothing) (const r) (const []) r ++mkEpsTUPW :: (ProductionRule p, EpsProductionRule p) => v ->+               TransformUPWrapper p surrIx unused1 unused2 phi ixT r t v+mkEpsTUPW v =+  MkTUPW $ \_ -> MkTUPIR (const False) (const $ Just $ epsilon v) (const die) (const [(True, epsilon (const v))]) $ epsilon v++mkEpsLTUPW :: (ProductionRule p, LiftableProductionRule p) => v -> Q Exp ->+              TransformUPWrapper p surrIx unused1 unused2 phi ixT r t v+mkEpsLTUPW v q =+  MkTUPW $ \_ -> MkTUPIR (const False) (const $ Just $ epsilonL v q) (const die) (const [(True, epsilonL (const v) [| const $(q) |])]) $ epsilonL v q+instance (ProductionRule p, LiftableProductionRule p) =>+         ProductionRule (TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t) where+  ra >>> rb = MkTUPW $ \g ->+    let (MkTUPIR rlaa eas ha tas fa) = tUPRuleForGrammar ra g+        (MkTUPIR rlab ebs hb tbs fb) = tUPRuleForGrammar rb g+        rla idx = rlaa idx || ((isJust $ eas idx) && rlab idx)+        es idx = liftM2 (>>>) (eas idx) (ebs idx)+        hForEmptyA idx = case eas idx of Nothing -> die+                                         Just rea -> rea >>> hb idx+        h idx =   hForEmptyA idx+              ||| ha idx >>> fb+        ts surrIdx =+          do (ea, ta) <- tas surrIdx+             if ea+               then do (eb,tb) <- tbs surrIdx+                       return (eb, epsilonL ap [| ap |] >>> ta >>> tb)+               else return (False, epsilonL flip [| flip |] >>> ta >>> fb)+        f = fa >>> fb+    in MkTUPIR rla es h ts f+  ra ||| rb = MkTUPW $ \g -> +    let (MkTUPIR rlaa eas ha tas fa) = tUPRuleForGrammar ra g+        (MkTUPIR rlab ebs hb tbs fb) = tUPRuleForGrammar rb g+        rla idx = rlaa idx || rlab idx+        es idx = liftM2 (|||) (eas idx) (ebs idx)+        h idx = ha idx ||| hb idx+        ts surrIdx = tas surrIdx ++ tbs surrIdx+    in MkTUPIR rla es h ts $ fa ||| fb+  endOfInput = mkSimpleTUPW endOfInput+  die = MkTUPW $ \_ -> MkTUPIR (const False) (const Nothing) (const die) (const []) die++instance (EpsProductionRule p) =>+         EpsProductionRule (TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t) where+  epsilon = mkEpsTUPW++instance (LiftableProductionRule p) =>+         LiftableProductionRule (TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t) where+  epsilonL = mkEpsLTUPW++instance (TokenProductionRule p t, ProductionRule p) =>+         TokenProductionRule (TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t) t where+  token tt = mkSimpleTUPW $ token tt++tlclTailRef :: (LiftableProductionRule p, LoopProductionRule p (UPDomain phi) (UPValue r)) =>+               phi ix -> p ([r ix -> r ix])+tlclTailRef idx = epsilonL (map unUPTV) [|map unUPTV|] >>> manyRef (UPTail idx) ++data WrapTransformUPWrapper p surrIx phi ixT r t ix = WrapTUPW {+  unWrapTUPW :: TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t (r ix)+  }++failHeadRefsTo :: (EqFam phi, ProductionRule p) =>+                  TransformUPGrammar p surrIx phi ixT r t -> phi ix ->+                  TransformUPGrammar p surrIx phi ixT r t +failHeadRefsTo g idx idx' = +  let+    nr = MkTUPW $ \g' -> +      let (MkTUPIR _ _ _ _ rf) = tUPRuleForGrammar (g' idx) g'+      in (MkTUPIR (eqIdx idx) (const Nothing) (\_ -> die) (\_ -> []) rf)+  in unWrapTUPW $ overrideIdx (WrapTUPW . g) idx (WrapTUPW nr) idx'++succeedTailRefs :: forall p surrIx phi ixT r t . (EqFam phi, ProductionRule p, LiftableProductionRule p) =>+                  TransformUPGrammar p surrIx phi ixT r t -> phi surrIx ->+                  TransformUPGrammar p surrIx phi ixT r t +succeedTailRefs g idx idx' = +  let+    nr = MkTUPW $ \g' -> +      let (MkTUPIR rla es rh _ rf) = tUPRuleForGrammar (g' idx) g'+      in (MkTUPIR rla es rh (\_ -> [(False, epsilonL id [|id|])]) rf)+  in unWrapTUPW $ overrideIdx (WrapTUPW . g) idx (WrapTUPW nr) idx'++instance (RecProductionRule p (UPDomain phi) (UPValue r),+          LiftableProductionRule p,+          EqFam phi,+          LoopProductionRule p (UPDomain phi) (UPValue r)) => +         RecProductionRule (TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t) phi r where+  ref (idx :: phi ix) =+    MkTUPW $ \g -> +    let g' :: TransformUPGrammar p surrIx phi ixT r t+        g' = failHeadRefsTo g idx+        MkTUPIR rla eas ha tas _ = tUPRuleForGrammar (g idx) g'+        h :: forall ix'. phi ix' -> p (r ix)+        h idx' = if rla idx' -- use True to turn off optimization+                 then epsilonL (foldr ($)) [| foldr ($) |] >>>+                      (hForEmptyHead idx' ||| ha idx') >>>+                      tlclTailRef idx+                 else f+        es idx' = if rla idx' -- use True to turn off optimization+                  then eas idx'+                  else Nothing+        hForEmptyHead :: forall ix' . phi ix' -> p (r ix)+        hForEmptyHead idx' = fromMaybe die $ eas idx'+        f = epsilonL unUPBV [|unUPBV|] >>> ref (UPBase idx)+    in MkTUPIR rla es h tas f ++data WrapListOfTailHeadManys p surrIx phi ixT r t ix = WLOTHM {+  unWLOTHM :: [(Bool, p (r ix -> [r surrIx]))]+  }+instance (EqFam phi,+          LiftableProductionRule p,+          LoopProductionRule p (UPDomain phi) (UPValue r)) => +         LoopProductionRule (TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t) phi r where+  -- TODO: fix!+  manyRef (idx :: phi ix) =+    MkTUPW $ \_ -> +    let tix :: p (r ix -> [r ix])+        tix = (flip (:) . map unUPBV, [| flip (:) . map unUPBV |]) $|>> manyRef (UPBase idx)+        ts :: phi surrIx -> [(Bool, p (r surrIx -> [r ix]))]+        ts surrIdx = unWLOTHM $ overrideIdx (\_ -> WLOTHM []) idx (WLOTHM [(False, tix)]) surrIdx+        f = (map unUPBV, [|map unUPBV|]) $|>> manyRef (UPBase idx)+    in MkTUPIR (\_ -> False) (const $ Just $ epsilonL [] [| [] |]) (const f) ts f +  many1Ref (idx :: phi ix) =+    MkTUPW $ \_ -> +    let tix :: p (r ix -> [r ix])+        tix = (flip (:) . map unUPBV, [| flip (:) . map unUPBV |]) $|>> many1Ref (UPBase idx)+        ts :: phi surrIx -> [(Bool, p (r surrIx -> [r ix]))]+        ts surrIdx = unWLOTHM $ overrideIdx (\_ -> WLOTHM []) idx (WLOTHM [(False, tix)]) surrIdx+        f = (map unUPBV, [|map unUPBV|]) $|>> many1Ref (UPBase idx)+    in MkTUPIR (\_ -> False) (const Nothing) (const f) ts f ++transformUniformPaull' ::+  forall p phi t r ix. +  (Domain phi, +   RecProductionRule p (UPDomain phi) (UPValue r),+   LiftableProductionRule p,+   LoopProductionRule p (UPDomain phi) (UPValue r),+   TokenProductionRule p t) =>+  (forall ixT ix' surrIx.+   phi ix' ->+   TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t (r ix')) ->+  UPDomain phi ix -> p (UPValue r ix)+transformUniformPaull' _ (UPBase idx) = +  let+    ruleHead = epsilonL unUPHV [|unUPHV|] >>> ref (UPHead idx)+    br = epsilonL (foldr ($)) [|foldr ($)|] >>> ruleHead >>> tlclTailRef idx+  in epsilonL UPBV [|UPBV|] >>> br+transformUniformPaull' bgram (UPHead (idx :: phi ix'')) = +  let+    intRule :: TransformUPIntRule p ix'' phi r (r ix'')+    intRule = tUPRuleForGrammar (bgram idx) (bgram `failHeadRefsTo` idx)+    ur :: p (r ix'')+    ur =   tlclwHead intRule idx+       ||| (fromMaybe die $ tlclwEmpty intRule idx)+  in epsilonL UPHV [| UPHV |] >>> ur+transformUniformPaull' bgram (UPTail (idx :: phi ix')) = +  let+    intRule = tUPRuleForGrammar (bgram idx) (bgram `succeedTailRefs` idx)+    ur = foldr ((|||) . snd) die $ filter (not . fst) $ tlclwTail intRule idx+  in epsilonL UPTV [|UPTV|] >>> ur++-- | Apply a uniform variant of the classic Paull transformation to a given grammar,+-- removing direct and indirect left recursion.+transformUniformPaull ::+  forall phi t r. Domain phi =>+  ProcessingContextFreeGrammar phi t r ->+  ProcessingExtendedContextFreeGrammar (UPDomain phi) t (UPValue r)+transformUniformPaull gram idx = transformUniformPaull' gram idx++-- | Apply a uniform variant of the classic Paull transformation to a given extended grammar,+-- removing direct and indirect left recursion.+transformUniformPaullE ::+  forall phi t r. Domain phi =>+  ProcessingExtendedContextFreeGrammar phi t r ->+  ProcessingExtendedContextFreeGrammar (UPDomain phi) t (UPValue r)+transformUniformPaullE gram idx = transformUniformPaull' gram idx++-- | Apply a uniform variant of the classic Paull transformation to a given extended liftable grammar,+-- removing direct and indirect left recursion.+transformUniformPaullLE ::+  forall phi t r. Domain phi =>+  ProcessingLExtendedContextFreeGrammar phi t r ->+  ProcessingLExtendedContextFreeGrammar (UPDomain phi) t (UPValue r)+transformUniformPaullLE gram idx = transformUniformPaull' gram idx
+ Text/GrammarCombinators/Utils/AssessSize.hs view
@@ -0,0 +1,68 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.AssessSize (+  assessSize+  ) where++import Text.GrammarCombinators.Base++newtype AssessSizeProductionRule (phi :: * -> *) (r :: * -> *) t v = ASPR {+  assessSizeRule :: Int+  }++instance ProductionRule (AssessSizeProductionRule phi r t) where+  endOfInput = ASPR 1 +  die = ASPR 1+  a ||| b = ASPR $ assessSizeRule a + assessSizeRule b+  a >>> b = ASPR $ assessSizeRule a + assessSizeRule b++instance EpsProductionRule (AssessSizeProductionRule phi r t) where+  epsilon _ = ASPR 1 ++instance LiftableProductionRule (AssessSizeProductionRule phi r t) where+  epsilonL _ _ = ASPR 1 ++instance (Token t) => TokenProductionRule (AssessSizeProductionRule phi r t) t where+  token _ = ASPR 1++instance RecProductionRule (AssessSizeProductionRule phi r t) phi r where+  ref _ = ASPR 1++instance LoopProductionRule (AssessSizeProductionRule phi r t) phi r where+  manyRef _ = ASPR 1+  many1Ref _ = ASPR 1++-- | Assess the size of a given grammar. Primitive rules ('token', 'ref', 'manyRef', 'many1Ref', 'epsilon')+--   are counted as 1 point, combinators like '|||' or '>>>' just add the points of their left and+--   right hand sides. Proposals for better metrics are welcome.+assessSize :: forall phi r t rr . (Token t, FoldFam phi) =>+              GExtendedContextFreeGrammar phi t r rr -> Int+assessSize gram =+  let+    f idx = assessSizeRule $ gram idx+  in foldFam ((+) . f) 0+
+ Text/GrammarCombinators/Utils/CalcFirst.hs view
@@ -0,0 +1,88 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}++module Text.GrammarCombinators.Utils.CalcFirst (+  FirstSet (FS, firstSet, canBeEmpty, canBeEOI),+  calcFirst+  ) where++import Data.Set (Set, union, singleton)+import qualified Data.Set as Set++import Text.GrammarCombinators.Base++data (Token t) => FirstSet t = +  FS {+    firstSet :: Set t,+    canBeEmpty :: Bool, +    canBeEOI :: Bool+    } deriving (Show)++newtype FSCalculator phi (r :: * -> *) t rr v = MkFSCalculator {+  calcFS :: FirstSetGrammar phi r t rr -> FirstSet t+  }+type FirstSetGrammar phi r t rr =+  forall ix. phi ix -> FSCalculator phi r t rr (rr ix)++instance (Token t) => ProductionRule (FSCalculator phi r t rr) where+  a >>> b = MkFSCalculator $ \g ->+    let FS fsa ea fa = calcFS a g+        FS fsb eb fb = calcFS b g+    in FS (if ea then fsa `union` fsb else fsa) (ea && eb) (fa || (ea && fb))+  a ||| b = MkFSCalculator $ \g ->+    let fa = calcFS a g+        fb = calcFS b g+    in FS { +      firstSet = firstSet fa `union` firstSet fb, +      canBeEmpty = canBeEmpty fa || canBeEmpty fb,+      canBeEOI = canBeEOI fa || canBeEOI fb }+  die = MkFSCalculator $ \_ -> FS Set.empty False False+  endOfInput = MkFSCalculator $ \_ -> FS Set.empty False True ++instance (Token t) => EpsProductionRule (FSCalculator phi r t rr) where+  epsilon _ = MkFSCalculator $ \_ -> FS Set.empty True False++instance (Token t) => LiftableProductionRule (FSCalculator phi r t rr) where+  epsilonL _ _ = MkFSCalculator $ \_ -> FS Set.empty True False++newtype WrapFSC phi r t rr ix = WFSC { unWFSC :: FSCalculator phi r t rr (rr ix) }++blockRecurse :: (EqFam phi, Token t) =>+                FirstSetGrammar phi r t rr -> phi idx -> FirstSetGrammar phi r t rr+blockRecurse gram idx = unWFSC . overrideIdx (WFSC . gram) idx (WFSC die)++instance (Token t) => TokenProductionRule (FSCalculator phi r t rr) t where+  token c = MkFSCalculator $ \_ -> FS (singleton c) False False+instance (Token t, EqFam phi) => RecProductionRule (FSCalculator phi r t rr) phi r where+  ref idx = MkFSCalculator $ \g -> calcFS (g idx) $ blockRecurse g idx+instance (Token t, EqFam phi) => LoopProductionRule (FSCalculator phi r t rr) phi r where+  -- first-set-wise, many1ref is identical to ref+  -- manyRef will be defaulted correctly+  many1Ref idx = MkFSCalculator $ \g -> calcFS (ref idx) g ++calcFirst :: (Domain phi, Token t) =>+                GExtendedContextFreeGrammar phi t r rr ->+                phi ix -> FirstSet t+calcFirst g idx = calcFS (ref idx) g+
+ Text/GrammarCombinators/Utils/EnumTokens.hs view
@@ -0,0 +1,84 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.EnumTokens ( +  enumRuleTokens,+  enumTokens,+  enumAllTokens+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Utils.IsReachable++newtype EnumTokensRule (phi :: * -> *) (r :: * -> *) t v = ETR {+  unETR :: [t]+  }++instance ProductionRule (EnumTokensRule phi r t) where+  die = ETR []+  endOfInput = ETR []+  a ||| b = ETR $ unETR a ++ unETR b+  a >>> b = ETR $ unETR a ++ unETR b++instance LiftableProductionRule (EnumTokensRule phi r t) where+  epsilonL v _ = epsilon v++instance EpsProductionRule (EnumTokensRule phi r t) where+  epsilon _ = ETR []++instance (Token t) => TokenProductionRule (EnumTokensRule phi r t) t where+  token t = ETR [t]++instance (ShowFam phi) => RecProductionRule (EnumTokensRule phi r t) phi r where+  ref _ = ETR []++instance (ShowFam phi) => LoopProductionRule (EnumTokensRule phi r t) phi r where+  manyRef _ = ETR []+  many1Ref _ = ETR []++-- | Enumerate all tokens that can be present in any match of a given production rule.+enumRuleTokens :: (Domain phi, Token t) =>+                  ExtendedContextFreeRule phi r t v -> [t]+enumRuleTokens rule = unETR rule++enumTokens' :: forall phi t r rr . (Token t, Domain phi) =>+               ((forall ix. phi ix -> [t] -> [t]) -> [t] -> [t]) ->+               GExtendedContextFreeGrammar phi t r rr -> [t]+enumTokens' fold' grammar =+  let+    addRuleTokens :: forall ix. phi ix -> [t] -> [t]+    addRuleTokens idx b = enumRuleTokens (grammar idx) ++ b+  in fold' addRuleTokens []++-- | Enumerate all tokens that can be present in any match of any string that can be matched +--   by a given non-terminal in a given grammar.+enumTokens :: (Token t, Domain phi) => GExtendedContextFreeGrammar phi t r rr -> phi ix -> [t]+enumTokens g idx = enumTokens' (foldReachable g idx) g++-- | Enumerate all tokens that can be present in any match of any string that can be matched +--   by any non-terminal in a given grammar.+enumAllTokens :: (Token t, Domain phi) => GExtendedContextFreeGrammar phi t r rr -> [t]+enumAllTokens = enumTokens' foldFam
+ Text/GrammarCombinators/Utils/EnumerateGrammar.hs view
@@ -0,0 +1,74 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.EnumerateGrammar where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Transform.FoldLoops++type EnumerateParserInternalGrammar phi t = forall ix . phi ix -> Int -> [[ConcreteToken t]]++newtype EnumerateProductionRule phi ixT r t v = IPP {+  printIPP :: EnumerateParserInternalGrammar phi t -> Int -> [[ConcreteToken t]]+  }++instance ProductionRule (EnumerateProductionRule phi ixT r t) where+  endOfInput = IPP $ \_ _ -> [[]]+  die = IPP $ \_ _ -> []+  a ||| b = IPP $ \g d -> printIPP a g d ++ printIPP b g d+  a >>> b = IPP $ \g d -> do x <- printIPP a g d+                             y <- printIPP b g d+                             return $ x ++ y++instance LiftableProductionRule (EnumerateProductionRule phi ixT r t) where+  epsilonL v _ = epsilon v++instance EpsProductionRule (EnumerateProductionRule phi ixT r t) where+  epsilon _ = IPP $ \_ _ -> [[]]++instance (Token t) => TokenProductionRule (EnumerateProductionRule phi ixT r t) t where+  token t = IPP $ \_ _ -> map (:[]) $ enumConcreteTokens t++instance RecProductionRule (EnumerateProductionRule phi ixT r t) phi r where+  ref idx = IPP $ \g d -> if d > 0 then g idx $ d-1 else []++type EnumerateGrammar phi ixT (r :: * -> *) t rr = forall ix. phi ix -> EnumerateProductionRule phi ixT r t (rr ix)++enumerateGrammar :: forall phi r t rr ix. (Token t, FoldFam phi, ShowFam phi) =>+                    GContextFreeGrammar phi t r rr -> Int -> phi ix -> [[ConcreteToken t]]+enumerateGrammar gram depth idx =+  let+    igram :: EnumerateGrammar phi ixT r t rr +    igram = gram+    intgram :: EnumerateParserInternalGrammar phi t+    intgram idx' = printIPP (igram idx') intgram+  in intgram idx depth+    +enumerateGrammarE ::+  forall phi r t rr ix. (Token t, FoldFam phi, ShowFam phi) =>+  GExtendedContextFreeGrammar phi t r rr -> Int -> phi ix -> [[ConcreteToken t]]+enumerateGrammarE gram depth idx =+  enumerateGrammar (foldLoops gram) depth (FLBase idx)
+ Text/GrammarCombinators/Utils/IsChainNT.hs view
@@ -0,0 +1,70 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.IsChainNT (+  isChainNT+  ) where++import Text.GrammarCombinators.Base++-- A rule is a chain rule if it is a sequence of epsilons followed by+-- a single reference to another NT, possibly followed by more epsilons+data IsChainNT (phi :: * -> *) (r :: * -> *) t rr v = MkITR {+  ruleIsEpsilon :: Bool,+  ruleIsChain :: Bool+  }++instance ProductionRule (IsChainNT phi r t rr) where+  ra >>> rb = +    let eps = ruleIsEpsilon ra && ruleIsEpsilon rb+        chain = ruleIsChain ra && ruleIsEpsilon rb ||+               ruleIsChain rb && ruleIsEpsilon ra+    in MkITR eps chain+  _ ||| _ = MkITR False False+  die = MkITR False False+  endOfInput = MkITR False False++instance EpsProductionRule (IsChainNT phi r t rr) where+  epsilon _ = MkITR True False++instance LiftableProductionRule (IsChainNT phi r t rr) where+  epsilonL _ _ = MkITR True False++instance TokenProductionRule (IsChainNT phi r t rr) t where+  token _ = MkITR False False++instance (EqFam phi) => RecProductionRule (IsChainNT phi r t rr) phi r where+  ref _ = MkITR False True++instance (EqFam phi) => LoopProductionRule (IsChainNT phi r t rr) phi r where+  manyRef _ = MkITR False False++-- | Detect if a given non-terminal in a given extended context free +-- grammar is a chain non-terminal. An NT is a chain NT if all of+-- its productions are chain rules.+isChainNT :: (EqFam phi) => GExtendedContextFreeGrammar phi t r rr -> phi idx -> Bool+isChainNT gram idx = ruleIsChain (gram idx)+
+ Text/GrammarCombinators/Utils/IsDead.hs view
@@ -0,0 +1,126 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.IsDead (+  isDead+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Utils.UnfoldDepthFirst++import Data.Maybe++import Control.Monad.State++data KnownDead phi = MkKD { knownDead :: forall ix. phi ix -> Maybe Bool }+newtype IsDeadRule phi (r :: * -> *) t (rr :: * -> *) v = MkIDR {+  -- second bool means dead or not+  -- first bool means dead state influenced by recursion cut-off+  ruleIsDead :: State (KnownDead phi) (Bool, Bool)+  }+cast :: IsDeadRule phi r t rr v -> IsDeadRule phi r t rr v'+cast = MkIDR . ruleIsDead++seqDead :: (Bool, Bool) -> (Bool, Bool) -> (Bool, Bool)+seqDead (False, True) _ = (False, True)+seqDead _ (False, True) = (False, True)+seqDead (ra, da) (rb, db) = (ra || rb, da || db)+altDead :: (Bool, Bool) -> (Bool, Bool) -> (Bool, Bool)+altDead (False, False) _ = (False, False)+altDead _ (False, False) = (False, False)+altDead (ra, da) (rb, db) = (ra || rb, da && db)++instance ProductionRule (IsDeadRule phi r t rr) where+  ra >>> rb = MkIDR $ liftM2 seqDead (ruleIsDead ra) (ruleIsDead rb)+  ra ||| rb = MkIDR $ liftM2 altDead (ruleIsDead ra) (ruleIsDead rb)+  die = MkIDR $ return (False, True)+  endOfInput = MkIDR $ return (False, False)++instance EpsProductionRule (IsDeadRule phi r t rr) where+  epsilon _ = MkIDR $ return (False, False)++instance LiftableProductionRule (IsDeadRule phi r t rr) where+  epsilonL _ _ = MkIDR $ return (False, False)++instance TokenProductionRule (IsDeadRule phi r t rr) t where+  token _ = MkIDR $ return (False, False)++instance (EqFam phi, MemoFam phi) =>+         SimpleRecProductionRule (IsDeadRule phi r t rr) phi r rr where+  ref' idx r = MkIDR $ do kds <- get+                          case knownDead kds idx of+                            (Just kd) -> return (False, kd)+                            _ -> do (rl,d) <- ruleIsDead r +                                    unless rl $ putDeath idx d +                                    return (rl, d)+  cutRecursion _ = MkIDR $ return (True, True)+  +instance (EqFam phi, MemoFam phi) =>+         SimpleLoopProductionRule (IsDeadRule phi r t rr) phi r rr where+  manyRef' _ _ = MkIDR $ return (False, False)+  many1Ref' idx r = cast (ref' idx r)++putDeath :: (EqFam phi, MemoFam phi) => phi ix -> Bool ->+            State (KnownDead phi) ()+putDeath idx d =+  do let setDead kd = MkKD $ memoFamilyK $ overrideIdxK (knownDead kd) idx $ Just d+     modify setDead++-- this is dead slow atm, we must be able to do better..+-- isDead1 :: forall phi t r rr ix. (EqFam phi, MemoFam phi) =>+--            GExtendedContextFreeGrammar phi t r rr ->+--            phi ix -> Bool+-- isDead1 gram idx = +--   let +--     ikd :: KnownDead phi+--     ikd = MkKD $ \_ -> Nothing+--   in snd $ evalState (ruleIsDead (unfoldDepthFirst gram idx)) ikd++-- | Detect if a given non-terminal in a given grammar is dead. A +-- non-terminal is dead if its production rule can never match+-- anything.+isDead :: forall phi t r rr ix. (EqFam phi, FoldFam phi, MemoFam phi) =>+          GExtendedContextFreeGrammar phi t r rr ->+          phi ix -> Bool+isDead gram = +  let+    ikd :: KnownDead phi+    ikd = MkKD $ \_ -> Nothing+    checkDead idx =+      do (_,d) <- ruleIsDead (unfoldDepthFirst gram idx)+         putDeath idx d+    checkAll = foldFam ((>>) . checkDead) (return ())+  in fromJust . knownDead (execState checkAll ikd)+ +-- foldDead :: forall phi r t rr ix b. (Domain phi) => +--             GExtendedContextFreeGrammar phi r t rr -> +--             (forall ix. phi ix -> b -> b) -> b -> b+-- foldDead grammar f n = +--   let+--     f' :: forall ix. phi ix -> b -> b+--     f' idx n = if isDead grammar idx then f idx n else n+--   in foldFam f' n+
+ Text/GrammarCombinators/Utils/IsEpsilon.hs view
@@ -0,0 +1,59 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}++module Text.GrammarCombinators.Utils.IsEpsilon ( +  isEpsilon+  ) where++import Text.GrammarCombinators.Base++newtype IsEpsilonRule (phi :: * -> *) (r :: * -> *) t v = MkIER {+  unIER :: Bool+  }+                        +instance ProductionRule (IsEpsilonRule phi r t) where+  ra >>> rb = MkIER $ unIER ra && unIER rb+  ra ||| rb = MkIER $ unIER ra && unIER rb+  die = MkIER False+  endOfInput = MkIER False++instance LiftableProductionRule (IsEpsilonRule phi r t) where+  epsilonL v _ = epsilon v++instance EpsProductionRule (IsEpsilonRule phi r t) where+  epsilon _ = MkIER True++instance TokenProductionRule (IsEpsilonRule phi r t) t where+  token _ = MkIER False+  +instance RecProductionRule (IsEpsilonRule phi r t) phi r where+  ref _ = MkIER False++instance LoopProductionRule (IsEpsilonRule phi r t) phi r where+  manyRef _ = MkIER False++-- | Detect if a given context-free rule is an epsilon rule.+isEpsilon :: ContextFreeRule phi r t v -> Bool+isEpsilon r = unIER r
+ Text/GrammarCombinators/Utils/IsReachable.hs view
@@ -0,0 +1,142 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.IsReachable (+  foldReachable,+  foldReachableProper,+  isReachable,+  isReachableProper+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Utils.UnfoldDepthFirst++import Control.Monad.State++newtype SeenGram phi = MkSG { seenIdx :: forall ix. phi ix -> Bool }+newtype Folder phi n = MkFF { foldIdxs :: (forall ix. phi ix -> n -> n) -> n -> n }+newtype FoldReachableIntRule phi (r :: * -> *) t (rr :: * -> *) n v = MkFRIR {+  foldRule :: State (SeenGram phi) (Folder phi n)+  }+combineFolders :: Folder phi n -> Folder phi n -> Folder phi n+combineFolders a b = MkFF $ \f n -> foldIdxs a f $ foldIdxs b f n+foldDeadEnd :: FoldReachableIntRule phi r t rr n v +foldDeadEnd = MkFRIR $ return $ MkFF $ \_ n -> n+foldVia :: FoldReachableIntRule phi r t rr n v -> FoldReachableIntRule phi r t rr n v' -> FoldReachableIntRule phi r t rr n v''  +foldVia ra rb = MkFRIR $ do fa <- foldRule ra+                            fb <- foldRule rb+                            return $ combineFolders fa fb+setSeen :: (EqFam phi) => phi ix -> SeenGram phi -> SeenGram phi+setSeen idx s = MkSG $ overrideIdxK (seenIdx s) idx True+putSeen :: (EqFam phi) => phi ix -> State (SeenGram phi) ()+putSeen idx = modify $ setSeen idx+noFold :: Folder phi n+noFold = MkFF $ const id+foldIdx :: phi ix -> Folder phi n+foldIdx idx = MkFF $ \f n -> f idx n+foldRef :: (EqFam phi) =>+           phi ix -> FoldReachableIntRule phi r t rr n (rr ix) -> +           FoldReachableIntRule phi r t rr n v+foldRef idx r = MkFRIR $ do s <- get+                            if seenIdx s idx+                              then return noFold+                              else do putSeen idx+                                      frec <- foldRule r +                                      return $ combineFolders frec $ foldIdx idx++instance ProductionRule (FoldReachableIntRule phi r t rr n) where+  ra >>> rb = foldVia ra rb+  ra ||| rb = foldVia ra rb+  die = foldDeadEnd+  endOfInput = foldDeadEnd++instance EpsProductionRule (FoldReachableIntRule phi r t rr n) where+  epsilon _ = foldDeadEnd++instance LiftableProductionRule (FoldReachableIntRule phi r t rr n) where+  epsilonL _ _ = foldDeadEnd++instance TokenProductionRule (FoldReachableIntRule phi r t rr n) t where+  token _ = foldDeadEnd++instance (EqFam phi) =>+         SimpleRecProductionRule (FoldReachableIntRule phi r t rr n) phi r rr where+  ref' = foldRef ++instance (EqFam phi) =>+         SimpleLoopProductionRule (FoldReachableIntRule phi r t rr n) phi r rr where+  manyRef' = foldRef +  many1Ref' = foldRef ++nothingSeen :: SeenGram phi+nothingSeen = MkSG $ \_ -> False++-- | Fold a given function over all non-terminals that are reachable +-- from a given non-terminal. This function is limited to proper+-- reachable rules (see 'isReachableProper' for what that means).+foldReachableProper :: forall phi r t rr ix n. (Domain phi) => +                       GExtendedContextFreeGrammar phi t r rr ->+                       phi ix ->+                       (forall ix'. phi ix' -> n -> n) -> n -> n+foldReachableProper grammar idx =+  foldIdxs $ evalState (foldRule (unfoldDepthFirstProper grammar idx)) nothingSeen++-- | Fold a given function over all non-terminals that are reachable +-- from a given non-terminal. This function will at least fold over the+-- given non-terminal itself.+foldReachable :: forall phi r rr t ix n. (Domain phi) => +                 GExtendedContextFreeGrammar phi t r rr ->+                 phi ix ->+                 (forall ix'. phi ix' -> n -> n) -> n -> n+foldReachable grammar idx =+  foldIdxs $ evalState (foldRule (unfoldDepthFirst grammar idx)) nothingSeen++isReachable' :: forall phi r t rr ix ix'. (Domain phi) => +               (forall n. +                GExtendedContextFreeGrammar phi t r rr -> phi ix ->+                (forall ix''. phi ix'' -> n -> n) -> n -> n) ->+               GExtendedContextFreeGrammar phi t r rr ->+               phi ix -> phi ix' -> Bool+isReachable' fold' g start end =+  fold' g start ((||) . eqIdx end) False++-- | Check if a given terminal is reachable from a given other grammar+-- in a given extended context-free grammar. This function assumes+-- that all grammars are reachable from themselves.+isReachable :: forall phi r t rr ix ix'. (Domain phi) => +               GExtendedContextFreeGrammar phi t r rr ->+               phi ix -> phi ix' -> Bool+isReachable = isReachable' foldReachable++-- | Check if a given terminal is reachable from a given other grammar+-- in a given extended context-free grammar. For this function, a non- +-- terminal is not automatically considered reachable from itself, but+-- only if it has some production in which a submatch of itself is+-- present.+isReachableProper :: forall phi r t rr ix ix'. (Domain phi) => +                     GExtendedContextFreeGrammar phi t r rr ->+                     phi ix -> phi ix' -> Bool+isReachableProper = isReachable' foldReachableProper
+ Text/GrammarCombinators/Utils/PrintGrammar.hs view
@@ -0,0 +1,105 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.PrintGrammar (+  printRule,+  printGrammar,+  printGrammarInf,+  printReachableGrammar+  ) where++import Text.GrammarCombinators.Base+import Text.GrammarCombinators.Utils.IsReachable++newtype PrintProductionRule (phi :: * -> *) (r :: * -> *) t v = IPP {+  printIPP :: Bool -> Bool -> Integer -> String+  }++printIPPSub :: Integer -> Bool -> Bool -> PrintProductionRule phi r t v -> String+printIPPSub d pd pc pp = if d > 0 then printIPP pp pd pc (d-1) else "..."++instance ProductionRule (PrintProductionRule phi r t) where+  die = IPP $ \_ _ _ -> "die"+  endOfInput = IPP $ \_ _ _ -> "EOI"+  a ||| b = IPP $ \pd _ d -> +    let t = printIPPSub d False True a ++ " | " ++ printIPPSub d False True b+    in if pd then "(" ++ t ++ ")" else t+  a >>> b = IPP $ \pd pc d ->+    if printIPPSub d pd pc a == "epsilon"+    then printIPPSub d pd pc b+    else if printIPPSub d pd pc b == "epsilon"+         then printIPPSub d pd pc a+         else let t = printIPPSub d True False a ++ " " ++ printIPPSub d True False b+              in if pc then "(" ++ t ++ ")" else t++instance EpsProductionRule (PrintProductionRule phi r t) where+  epsilon _ = IPP $ \_ _ _ -> "epsilon"++instance LiftableProductionRule (PrintProductionRule phi r t) where+  epsilonL _ _ = IPP $ \_ _ _ -> "epsilon"++instance (Token t) => TokenProductionRule (PrintProductionRule phi r t) t where+  token t = IPP $ \_ _ _ -> show t++instance (ShowFam phi) => RecProductionRule (PrintProductionRule phi r t) phi r where+  ref idx = IPP $ \_ _ _ -> "<" ++ showIdx idx ++ ">"++instance (ShowFam phi) => LoopProductionRule (PrintProductionRule phi r t) phi r where+  manyRef idx = IPP $ \_ _ _ -> "<" ++ showIdx idx ++ ">" ++ "*"+  many1Ref idx = IPP $ \_ _ _ -> "<" ++ showIdx idx ++ ">" ++ "+"++-- | Print out a single production rule+printRule :: (Domain phi, Token t) => GExtendedContextFreeGrammar phi t r rr -> Integer -> phi ix -> String+printRule gram depth idx = "<" ++ showIdx idx ++ ">" ++ " ::= " ++ printIPP (gram idx) False False depth++printGrammar' :: forall phi t r rr. (Domain phi, Token t) =>+                 (forall b. (forall ix. phi ix -> b -> b) -> b -> b) ->+                 GExtendedContextFreeGrammar phi t r rr -> Integer -> String+printGrammar' fold' gram depth =+  unlines $ fold' ((:) . printRule gram depth) []++-- close enough... +infinity :: Integer+infinity = 999999999999999999999999999999++-- | Print out a full grammar.+printGrammar :: forall phi t r rr. (Domain phi, Token t) =>+                GExtendedContextFreeGrammar phi t r rr -> String+printGrammar g = printGrammar' foldFam g infinity++-- | Print out a grammar with a depth limit. Intended for infinite grammars.+printGrammarInf :: forall phi t r rr. (Domain phi, Token t) =>+                GExtendedContextFreeGrammar phi t r rr -> Integer -> String+printGrammarInf = printGrammar' foldFam ++-- | Print out the part of a grammar that is reachable from a given non-terminal.+printReachableGrammar ::+  forall phi t r rr ix.+  (Domain phi, Token t) =>+  GExtendedContextFreeGrammar phi t r rr ->+  phi ix -> String+printReachableGrammar gram idx = printGrammar' (foldReachable gram idx) gram infinity+
+ Text/GrammarCombinators/Utils/ToGraph.hs view
@@ -0,0 +1,177 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.ToGraph (+  ruleToGraph,+  graphToGraphviz,+  fullGrammarToGraph,+  reachableGrammarToGraph,+  showGraph+  ) where++import Text.GrammarCombinators.Base++import Text.GrammarCombinators.Utils.IsReachable++import Data.Graph.Inductive.Graph++import Control.Monad.State+import Control.Monad.Writer++import Data.Graph.Inductive.PatriciaTree+import Data.GraphViz++newNode :: (MonadState (Int, Int) m) => m Int+newNode = do (d, n) <- get+             put (d, n + 1)+             return n+tell1 :: (MonadWriter [w] m) => w -> m ()+tell1 w = tell [w]++newtype GraphConstructor (phi :: * -> *) (r :: * -> *) t v =+  MkGC {+    constructContexts ::+       Adj String -> Bool -> +       WriterT [Context String String] (State (Int, Int)) (Adj String)+  }++leafNode :: String -> Bool -> GraphConstructor phi r t v+leafNode label eps = MkGC $ \parentEdge printeps ->+     if not eps || printeps+       then do ln <- newNode+               tell1 (parentEdge, ln, label, [])+               return [("",ln)]+       else return parentEdge++constructContextsSub :: GraphConstructor phi r t v -> Adj String ->+                        Bool ->+                        WriterT [Context String String] (State (Int, Int)) (Adj String)+constructContextsSub r pe printeps = +  do (d, n) <- get+     if d > 0+       then put (d-1,n) >>+            constructContexts r pe printeps+       else do n' <- newNode+               tell1 (pe, n', "(...)", [])+               return []++instance ProductionRule (GraphConstructor phi r t) where+  ra >>> rb = MkGC $ \parentEdge printeps ->+    do (d,_) <- get+       pe <- constructContextsSub ra parentEdge False+       if null pe+         then return []+         else do modify $ \(_,n) -> (d,n) -- do not ignore right branches if left ones are infinite...+                 constructContextsSub rb pe printeps +  ra ||| rb = MkGC $ \parentEdge _ ->+    do (d,_) <- get +       pea <- constructContextsSub ra parentEdge True+       modify $ \(_,n) -> (d,n)+       peb <- constructContextsSub rb parentEdge True+       return $ pea ++ peb+  endOfInput = leafNode "endOfInput" False+  die = leafNode "die" False++instance EpsProductionRule (GraphConstructor phi r t) where+  epsilon _ = leafNode "epsilon" True++instance LiftableProductionRule (GraphConstructor phi r t) where+  epsilonL _ _ = leafNode "epsilon" True++instance (Token t) => +         TokenProductionRule (GraphConstructor phi r t) t where+  token tt = leafNode (show tt) False+  +instance (Domain phi) => RecProductionRule (GraphConstructor phi r t) phi r where+  ref idx = leafNode ("<" ++ showIdx idx ++ ">") False++instance (Domain phi) => LoopProductionRule (GraphConstructor phi r t) phi r where+  manyRef idx = leafNode ("<" ++ showIdx idx ++ ">*") False++ruleToGraph :: forall phi t r rr gr ix. (Token t, Domain phi, DynGraph gr) => +           Int -> GExtendedContextFreeGrammar phi t r rr ->+           phi ix -> gr String String+ruleToGraph depth gram idx = buildGr $ snd $ ruleToContexts depth gram idx 0++ruleToContexts :: forall phi t r rr ix. (Token t, Domain phi) => +           Int -> GExtendedContextFreeGrammar phi t r rr ->+           phi ix -> Int -> (Int, [Context String String])+ruleToContexts depth gram idx sn =+  let +    processNTDef :: phi ix ->+                    WriterT [Context String String] (State (Int, Int)) (Adj String)+    processNTDef idx' =+      do ntNode <- newNode+         tell1 ([], ntNode, showIdx idx', [])+         let stAdj = [("", ntNode)]+         constructContexts (gram idx') stAdj True+    (contexts, (_,nsn)) = flip runState (depth, sn) $ execWriterT $ processNTDef idx+  in (nsn, reverse contexts)++graphvizParams :: GraphvizParams String String () String+graphvizParams = Params {+  isDirected = True, +  globalAttributes = [], +  clusterBy = N, +  clusterID = const Nothing,+  fmtCluster = const [],+  fmtNode = \(_,n) -> [Label $ StrLabel n],+  fmtEdge = \(_,_,_) -> [] +  }++graphToGraphviz :: Gr String String -> DotGraph Node+graphToGraphviz gr = setID (Str "Grammar") $ graphToDot graphvizParams (gr :: Gr String String)++grammarToContexts :: forall phi t r rr . (Token t, Domain phi) =>+                     (forall b. (forall ix. phi ix -> b -> b) -> b -> b) ->+                     Int -> GExtendedContextFreeGrammar phi t r rr ->+                     [Context String String]+grammarToContexts fold' depth gram =+  let+      processRule idx (nsn, cs) = (nsn', cs ++ cs')+        where (nsn', cs') = ruleToContexts depth gram idx nsn +  in snd $ fold' processRule (0,[])++grammarToGraph :: forall phi t r rr gr . (Token t, Domain phi, DynGraph gr) => +                  (forall b. (forall ix. phi ix -> b -> b) -> b -> b) ->+                  Int -> GExtendedContextFreeGrammar phi t r rr ->+                  gr String String+grammarToGraph fold' depth gram = buildGr $ grammarToContexts fold' depth gram++fullGrammarToGraph :: forall phi t r rr gr . (Token t, Domain phi, DynGraph gr) => +                      Int -> GExtendedContextFreeGrammar phi t r rr ->+                      gr String String+fullGrammarToGraph = grammarToGraph foldFam+reachableGrammarToGraph :: forall phi t r rr gr ix . (Token t, Domain phi, DynGraph gr) => +                  Int -> GExtendedContextFreeGrammar phi t r rr -> phi ix ->+                  gr String String+reachableGrammarToGraph depth gram idx = grammarToGraph (foldReachable gram idx) depth gram++void :: (Monad m) => m a -> m ()+void m = m >> return ()++showGraph :: (DotRepr dg n) => dg n -> IO ()+showGraph gr = void $ runGraphvizCanvas' gr Xlib
+ Text/GrammarCombinators/Utils/UnfoldDepthFirst.hs view
@@ -0,0 +1,136 @@+{-  Copyright 2010 Dominique Devriese++    This file is part of the grammar-combinators library.++    The grammar-combinators library is free software: you can+    redistribute it and/or modify it under the terms of the GNU+    Lesser General Public License as published by the Free+    Software Foundation, either version 3 of the License, or (at+    your option) any later version.++    Foobar is distributed in the hope that it will be useful, but+    WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+    GNU Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General+    Public License along with Foobar. If not, see+    <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GrammarCombinators.Utils.UnfoldDepthFirst where++import Text.GrammarCombinators.Base++-- TODO: use UnfoldLoops and UnfoldRecursion instead of redoing everything?++class (ProductionRule p) =>+      SimpleRecProductionRule p phi r rr | p -> phi, p -> r, p -> rr where+  ref' :: phi ix -> p (rr ix) -> p (r ix)+  cutRecursion :: phi ix -> p (rr ix)+  cutRecursion _ = die++class SimpleLoopProductionRule p phi r rr | p -> phi, p -> r, p -> rr where+  manyRef' :: phi ix -> p (rr ix) -> p [r ix]+  many1Ref' :: phi ix -> p (rr ix) -> p [r ix]++newtype UnfoldDepthFirstRule p (phi :: * -> *) (r :: * -> *) t (rr :: * -> *) v = MkFRR {+  foldReachableFromRule :: UDFGrammar p phi r t rr ->+                           p v+  }++type UDFGrammar p phi r t rr =+  forall ix. phi ix -> p (rr ix)++instance (ProductionRule p) => ProductionRule (UnfoldDepthFirstRule p phi r t rr) where+  ra >>> rb = MkFRR $ \g -> foldReachableFromRule ra g >>> foldReachableFromRule rb g+  ra ||| rb = MkFRR $ \g -> foldReachableFromRule ra g |||  foldReachableFromRule rb g+  die = MkFRR $ \_ -> die+  endOfInput = MkFRR $ \_ -> endOfInput++instance (EpsProductionRule p) => EpsProductionRule (UnfoldDepthFirstRule p phi r t rr) where+  epsilon v = MkFRR $ \_ -> epsilon v++instance (LiftableProductionRule p) => LiftableProductionRule (UnfoldDepthFirstRule p phi r t rr) where+  epsilonL v q = MkFRR $ \_ -> epsilonL v q++instance (TokenProductionRule p t) =>+         TokenProductionRule (UnfoldDepthFirstRule p phi r t rr) t where+  token tt = MkFRR $ \_ -> token tt+  +instance (SimpleRecProductionRule p phi r rr) =>+         RecProductionRule (UnfoldDepthFirstRule p phi r t rr) phi r where+  ref idx = MkFRR $ \g -> ref' idx (g idx) ++instance (ProductionRule p,+          LiftableProductionRule p,+          SimpleRecProductionRule p phi r rr,+          SimpleLoopProductionRule p phi r rr) =>+         LoopProductionRule (UnfoldDepthFirstRule p phi r t rr) phi r where+  manyRef idx = MkFRR $ \g -> manyRef' idx (g idx) +  many1Ref idx = MkFRR $ \g -> many1Ref' idx (g idx)++newtype WrapUR p r ix = WUR { unWUR :: p (r ix) }++declareDead :: (EqFam phi, ProductionRule p,+                SimpleRecProductionRule p phi r rr) =>+               phi ix ->+               UDFGrammar p phi r t rr ->+               UDFGrammar p phi r t rr +declareDead idx g = unWUR . overrideIdx (WUR . g) idx (WUR $ cutRecursion idx)+++unfoldDepthFirst'' :: forall p phi r rr t v.+                   (ProductionRule p, EqFam phi,+                    TokenProductionRule p t,+                    EpsProductionRule p,+                    SimpleRecProductionRule p phi r rr,+                    SimpleLoopProductionRule p phi r rr) =>+                   UnfoldDepthFirstRule p phi r t rr v ->+                   GExtendedContextFreeGrammar phi t r rr ->+                   (UDFGrammar p phi r t rr -> UDFGrammar p phi r t rr) ->+                   p v+unfoldDepthFirst'' r grammar rg =+  foldReachableFromRule r (rg (unfoldDepthFirst' grammar rg)) ++unfoldDepthFirst' :: forall p phi r rr t ix.+                   (ProductionRule p, EqFam phi,+                    EpsProductionRule p,+                    TokenProductionRule p t,+                    SimpleRecProductionRule p phi r rr,+                    SimpleLoopProductionRule p phi r rr) =>+                   GExtendedContextFreeGrammar phi t r rr ->+                   (UDFGrammar p phi r t rr -> UDFGrammar p phi r t rr) ->+                   phi ix -> p (rr ix)+unfoldDepthFirst' grammar rg idx =+  let+    nrg :: UDFGrammar p phi r t rr -> UDFGrammar p phi r t rr+    nrg g = declareDead idx (rg g)+  in unfoldDepthFirst'' (grammar idx) grammar nrg ++unfoldDepthFirstProper :: forall p phi r rr t ix.+                   (ProductionRule p, EqFam phi,+                    EpsProductionRule p,+                    TokenProductionRule p t,+                    SimpleRecProductionRule p phi r rr,+                    SimpleLoopProductionRule p phi r rr) =>+                   GExtendedContextFreeGrammar phi t r rr ->+                   phi ix -> p (rr ix)+unfoldDepthFirstProper grammar = unfoldDepthFirst' grammar id ++unfoldDepthFirst :: forall p phi r rr t ix.+                   (ProductionRule p, EqFam phi,+                    EpsProductionRule p,+                    TokenProductionRule p t,+                    SimpleRecProductionRule p phi r rr,+                    SimpleLoopProductionRule p phi r rr) =>+                   GExtendedContextFreeGrammar phi t r rr ->+                   phi ix -> p (r ix)+unfoldDepthFirst grammar idx = unfoldDepthFirst'' (ref idx) grammar id +
+ grammar-combinators.cabal view
@@ -0,0 +1,71 @@+Name:                grammar-combinators+Version:             0.1+Description:+    The grammar-combinators library is a novel parsing library using+    an explicit representation of recursion to provide various novel+    features, for grammar analysis, transformation and parsing+    functionality.+License:             LGPL+License-file:        COPYING.LGPL+Homepage:	     http://projects.haskell.org/grammar-combinators/ +Author:              Dominique Devriese <dominique.devriese@gmail.com>+Maintainer:          Dominique Devriese <dominique.devriese@gmail.com>+Build-Type:          Simple+Category:	     Parsing+Synopsis:	     A parsing library of context-free grammar combinators.+Cabal-Version:       >=1.2.1+Extra-Source-Files:  COPYING.GPL +Stability:	     experimental++Library+  Build-Depends:     base >= 3 && < 5,+                     multirec >= 0.4,+                     template-haskell >= 2.4.0.0,+                     enumerable >= 0.0.3,+                     mtl >= 1.1,+                     containers >= 0.3,+                     parsec >= 3.1,+                     MaybeT >= 0.1.2,+                     uu-parsinglib >= 2.5.1,+                     graphviz >= 2999.10,+                     fgl >= 5.4.2.2+  Exposed-modules:   Text.GrammarCombinators.Base.Domain+                     Text.GrammarCombinators.Base.Grammar+                     Text.GrammarCombinators.Base+                     Text.GrammarCombinators.Base.MultiRec+                     Text.GrammarCombinators.Base.ProductionRule+                     Text.GrammarCombinators.Base.Processor+                     Text.GrammarCombinators.Base.Token+                     Text.GrammarCombinators.Parser.LL1+                     Text.GrammarCombinators.Parser.LL1TH+                     Text.GrammarCombinators.Parser.Packrat+                     Text.GrammarCombinators.Parser.Parsec+                     Text.GrammarCombinators.Parser.RealLL1+                     Text.GrammarCombinators.Parser.RecursiveDescent+                     Text.GrammarCombinators.Parser.TopDown+                     Text.GrammarCombinators.Parser.UUParse+                     Text.GrammarCombinators.TH.Base+                     Text.GrammarCombinators.TH.FoldLoops+                     Text.GrammarCombinators.TH.RealLL1+                     Text.GrammarCombinators.Transform.CombineEpsilons+                     Text.GrammarCombinators.Transform.FilterDies+                     Text.GrammarCombinators.Transform.FoldLoops+                     Text.GrammarCombinators.Transform.LeftCorner+                     Text.GrammarCombinators.Transform.OptimizeGrammar+                     Text.GrammarCombinators.Transform.UnfoldChainNTs+                     Text.GrammarCombinators.Transform.UnfoldDead+                     Text.GrammarCombinators.Transform.UnfoldLoops+                     Text.GrammarCombinators.Transform.UnfoldRecursion+                     Text.GrammarCombinators.Transform.UniformPaull+                     Text.GrammarCombinators.Utils.AssessSize+                     Text.GrammarCombinators.Utils.CalcFirst+                     Text.GrammarCombinators.Utils.EnumerateGrammar+                     Text.GrammarCombinators.Utils.EnumTokens+                     Text.GrammarCombinators.Utils.IsChainNT+                     Text.GrammarCombinators.Utils.IsDead+                     Text.GrammarCombinators.Utils.IsEpsilon+                     Text.GrammarCombinators.Utils.IsReachable+                     Text.GrammarCombinators.Utils.PrintGrammar+                     Text.GrammarCombinators.Utils.ToGraph+                     Text.GrammarCombinators.Utils.UnfoldDepthFirst+  ghc-options:       -Wall