BNFC-2.6.0.3/0000755000000000000000000000000012100475644010561 5ustar0000000000000000BNFC-2.6.0.3/BNFC.cabal0000644000000000000000000000721212100475644012257 0ustar0000000000000000Name: BNFC Version: 2.6.0.3 cabal-version: >= 1.8 build-type: Simple category: Development Copyright: (c) Krasimir Angelov, Jean-Philippe Bernardy, Bjorn Bringert, Johan Broberg, Paul Callaghan, Markus Forsberg, Ola Frid, Peter Gammie, Patrik Jansson, Kristofer Johannisson, Antti-Juhani Kaijanaho, Ulf Norell, Michael Pellauer and Aarne Ranta 2002 - 2012. Free software under GNU General Public License (GPL). License: GPL License-File: LICENSE Maintainer: bnfc-dev@googlegroups.com Homepage: http://bnfc.digitalgrammars.com/ bug-reports: https://github.com/BNFC/bnfc/issues Synopsis: A compiler front-end generator. Description: The BNF Converter is a compiler construction tool generating a compiler front-end from a Labelled BNF grammar. It was originally written to generate Haskell, but starting from Version 2.0, it can also be used for generating Java, C++, and C. . Given a Labelled BNF grammar the tool produces: an abstract syntax as a Haskell/C++/C module or Java directory, a case skeleton for the abstract syntax in the same language, an Alex, JLex, or Flex lexer generator file, a Happy, CUP, or Bison parser generator file, a pretty-printer as a Haskell/Java/C++/C module, a Latex file containing a readable specification of the language. Extra-source-files: src/BNF.cf Library hs-source-dirs: runtime, src Build-Depends: base>=4.4 && <5, array exposed-modules: Algebra.RingUtils Data.Pair Data.Matrix.Quad Data.Matrix.Class Parsing.Chart Parsing.TestProgram Executable bnfc Build-Depends: base>=4.4 && <5, mtl, directory, array, process, containers, pretty >=1.1 && <1.2, BNFC Main-is: Main.hs HS-source-dirs: src src/formats src/formats/haskell2 src/formats/haskell-gadt src/formats/xml src/formats/profile src/formats/java src/formats/java1.5 src/formats/cpp src/formats/c src/formats/ocaml src/formats/cpp_stl src/formats/c-sharp src/formats/f-sharp Other-modules: LexBNF, ParBNF, AbsBNF, PrintBNF, Utils, CF, ErrM, MultiView, TypeChecker, GetCF, NamedVariables, OOAbstract, CFtoLatex, CFtoXML, CFtoTxt, Options, ToCNF, -- Haskell HaskellTop, RegToAlex, CFtoTemplate, CFtoAlex3, CFtoAlex2, CFtoAlex, CFtoHappy, CFtoPrinter, CFtoAbstract, CFtoLayout, MkErrM, MkSharedString, HsOpts, -- Profile ProfileTop, CFtoHappyProfile, -- Haskell GADT HaskellTopGADT, HaskellGADTCommon, CFtoPrinterGADT, CFtoTemplateGADT, CFtoAbstractGADT, -- O'Caml OCamlTop, OCamlUtil, CFtoOCamlTest, CFtoOCamlShow, CFtoOCamlPrinter, CFtoOCamlTemplate, CFtoOCamlAbs, CFtoOCamlYacc, CFtoOCamlLex, -- C CTop, CFtoCPrinter, CFtoCSkel, CFtoBisonC, CFtoFlexC, CFtoCAbs, CFtoCVisitSkel, -- C++ CPPTop, RegToFlex, CFtoFlex, CFtoBison, CFtoCPPPrinter, CFtoCPPAbs, -- C++ STL CFtoBisonSTL, CFtoSTLAbs, STLUtils, CFtoCVisitSkelSTL, CFtoSTLPrinter, STLTop, -- C# CSharpTop, RegToGPLEX, CFtoGPLEX, CSharpUtils, CFtoCSharpPrinter, CAbstoCSharpAbs, CAbstoCSharpAbstractVisitSkeleton, CAbstoCSharpVisitSkeleton, CFtoGPPG, -- Java JavaTop, RegToJLex, CFtoCup, CFtoVisitSkel, CFtoJavaSkeleton, CFtoJavaPrinter, CFtoJavaAbs, CFtoJLex, -- Java 1.5 JavaTop15, CFtoJavaAbs15, CFtoAllVisitor, CFtoFoldVisitor, CFtoAbstractVisitor, CFtoComposVisitor, CFtoVisitSkel15, CFtoJavaPrinter15, CFtoJLex15, CFtoCup15, -- F-sharp FSharpTop BNFC-2.6.0.3/Setup.lhs0000644000000000000000000000015512100475644012372 0ustar0000000000000000#!/usr/bin/env runghc > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain BNFC-2.6.0.3/LICENSE0000644000000000000000000004313112100475635011570 0ustar0000000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) 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 this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. 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. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the 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 a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE 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. 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 convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision 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, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This 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 Library General Public License instead of this License. BNFC-2.6.0.3/dist/0000755000000000000000000000000012100475635011524 5ustar0000000000000000BNFC-2.6.0.3/dist/build/0000755000000000000000000000000012100475635012623 5ustar0000000000000000BNFC-2.6.0.3/dist/build/bnfc/0000755000000000000000000000000012100475635013533 5ustar0000000000000000BNFC-2.6.0.3/dist/build/bnfc/bnfc-tmp/0000755000000000000000000000000012100475636015242 5ustar0000000000000000BNFC-2.6.0.3/dist/build/bnfc/bnfc-tmp/LexBNF.hs0000644000000000000000000016344112100475635016664 0ustar0000000000000000{-# LANGUAGE CPP,MagicHash #-} {-# LINE 3 "src/LexBNF.x" #-} {-# OPTIONS -fno-warn-incomplete-patterns #-} module LexBNF where import qualified Data.Bits import Data.Word (Word8) #if __GLASGOW_HASKELL__ >= 603 #include "ghcconfig.h" #elif defined(__GLASGOW_HASKELL__) #include "config.h" #endif #if __GLASGOW_HASKELL__ >= 503 import Data.Array import Data.Char (ord) import Data.Array.Base (unsafeAt) #else import Array import Char (ord) #endif #if __GLASGOW_HASKELL__ >= 503 import GHC.Exts #else import GlaExts #endif alex_base :: AlexAddr alex_base = AlexA# "\xf8\xff\xff\xff\x49\x00\x00\x00\x1c\x01\x00\x00\xc9\xff\xff\xff\xe0\xff\xff\xff\x9c\x01\x00\x00\x6f\x02\x00\x00\x2d\x00\x00\x00\xef\x02\x00\x00\xef\x03\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\xe0\x03\x00\x00\xe0\x04\x00\x00\xdd\x01\x00\x00\x60\x05\x00\x00\x24\x06\x00\x00\x82\x06\x00\x00\x20\x05\x00\x00\x00\x00\x00\x00\x38\x06\x00\x00\xdb\xff\xff\xff\x47\x00\x00\x00\x5a\x00\x00\x00\x38\x07\x00\x00\x39\x07\x00\x00\xfc\x07\x00\x00\xbc\x07\x00\x00\x00\x00\x00\x00\xb2\x08\x00\x00\x85\x09\x00\x00\x00\x00\x00\x00\x78\x00\x00\x00\xdc\xff\xff\xff\xdd\xff\xff\xff\x00\x00\x00\x00\xdf\xff\xff\xff\x5e\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x00\x00\x00\x7a\x06\x00\x00\x7c\x00\x00\x00"# alex_table :: AlexAddr alex_table = AlexA# "\x00\x00\x20\x00\x20\x00\x20\x00\x20\x00\x20\x00\x23\x00\x27\x00\x17\x00\x1d\x00\x06\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x20\x00\x03\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x21\x00\x23\x00\x00\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x24\x00\x23\x00\x00\x00\x23\x00\x00\x00\x23\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x23\x00\x04\x00\x23\x00\x00\x00\x23\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x22\x00\x23\x00\x23\x00\x02\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x20\x00\x20\x00\x20\x00\x20\x00\x20\x00\x00\x00\x00\x00\x00\x00\x04\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x04\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x07\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x0d\x00\x0e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x26\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x11\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x10\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1b\x00\x05\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x14\x00\x08\x00\x0b\x00\x0b\x00\x0b\x00\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# alex_check :: AlexAddr alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3d\x00\x27\x00\x2d\x00\x2d\x00\x2d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x20\x00\x3a\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x27\x00\x5d\x00\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x2d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x5c\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x74\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7d\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7d\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xc2\x00\xc3\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xc2\x00\xc3\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# alex_deflt :: AlexAddr alex_deflt = AlexA# "\xff\xff\x06\x00\x06\x00\xff\xff\xff\xff\xff\xff\x06\x00\xff\xff\xff\xff\x06\x00\x06\x00\x13\x00\x13\x00\x04\x00\x04\x00\xff\xff\x18\x00\xff\xff\x18\x00\x1c\x00\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# alex_accept = listArray (0::Int,42) [[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_8))]] {-# LINE 37 "src/LexBNF.x" #-} tok f p s = f p s share :: String -> String share = id data Tok = TS !String !Int -- reserved words and symbols | TL !String -- string literals | TI !String -- integer literals | TV !String -- identifiers | TD !String -- double precision float literals | TC !String -- character literals deriving (Eq,Show,Ord) data Token = PT Posn Tok | Err Posn deriving (Eq,Show,Ord) tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l tokenPos (Err (Pn _ l _) :_) = "line " ++ show l tokenPos _ = "end of file" tokenPosn (PT p _) = p tokenPosn (Err p) = p tokenLineCol = posLineCol . tokenPosn posLineCol (Pn _ l c) = (l,c) mkPosToken t@(PT p _) = (posLineCol p, prToken t) prToken t = case t of PT _ (TS s _) -> s PT _ (TL s) -> s PT _ (TI s) -> s PT _ (TV s) -> s PT _ (TD s) -> s PT _ (TC s) -> s data BTree = N | B String Tok BTree BTree deriving (Show) eitherResIdent :: (String -> Tok) -> String -> Tok eitherResIdent tv s = treeFind resWords where treeFind N = tv s treeFind (B a t left right) | s < a = treeFind left | s > a = treeFind right | s == a = t resWords = b "digit" 21 (b "=" 11 (b "-" 6 (b "*" 3 (b ")" 2 (b "(" 1 N N) N) (b "," 5 (b "+" 4 N N) N)) (b "::=" 9 (b ":" 8 (b "." 7 N N) N) (b ";" 10 N N))) (b "char" 16 (b "]" 14 (b "[" 13 (b "?" 12 N N) N) (b "_" 15 N N)) (b "define" 19 (b "comment" 18 (b "coercions" 17 N N) N) (b "delimiters" 20 N N)))) (b "separator" 31 (b "letter" 26 (b "internal" 24 (b "eps" 23 (b "entrypoints" 22 N N) N) (b "layout" 25 N N)) (b "position" 29 (b "nonempty" 28 (b "lower" 27 N N) N) (b "rules" 30 N N))) (b "upper" 36 (b "token" 34 (b "terminator" 33 (b "stop" 32 N N) N) (b "toplevel" 35 N N)) (b "|" 39 (b "{" 38 (b "views" 37 N N) N) (b "}" 40 N N)))) where b s n = let bs = id s in B bs (TS bs n) unescapeInitTail :: String -> String unescapeInitTail = id . unesc . tail . id where unesc s = case s of '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs '\\':'n':cs -> '\n' : unesc cs '\\':'t':cs -> '\t' : unesc cs '"':[] -> [] c:cs -> c : unesc cs _ -> [] ------------------------------------------------------------------- -- Alex wrapper code. -- A modified "posn" wrapper. ------------------------------------------------------------------- data Posn = Pn !Int !Int !Int deriving (Eq, Show,Ord) alexStartPos :: Posn alexStartPos = Pn 0 1 1 alexMove :: Posn -> Char -> Posn alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 alexMove (Pn a l c) _ = Pn (a+1) l (c+1) type Byte = Word8 type AlexInput = (Posn, -- current position, Char, -- previous char [Byte], -- pending bytes on the current char String) -- current input string tokens :: String -> [Token] tokens str = go (alexStartPos, '\n', [], str) where go :: AlexInput -> [Token] go inp@(pos, _, _, str) = case alexScan inp 0 of AlexEOF -> [] AlexError (pos, _, _, _) -> [Err pos] AlexSkip inp' len -> go inp' AlexToken inp' len act -> act pos (take len str) : (go inp') alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s)) alexGetByte (p, _, [], s) = case s of [] -> Nothing (c:s) -> let p' = alexMove p c (b:bs) = utf8Encode c in p' `seq` Just (b, (p', c, bs, s)) alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (p, c, bs, s) = c -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. utf8Encode :: Char -> [Word8] utf8Encode = map fromIntegral . go . ord where go oc | oc <= 0x7f = [oc] | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6) , 0x80 + oc Data.Bits..&. 0x3f ] | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12) , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) , 0x80 + oc Data.Bits..&. 0x3f ] | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18) , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f) , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) , 0x80 + oc Data.Bits..&. 0x3f ] alex_action_3 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) alex_action_4 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) alex_action_5 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) alex_action_6 = tok (\p s -> PT p (TC $ share s)) alex_action_7 = tok (\p s -> PT p (TI $ share s)) alex_action_8 = tok (\p s -> PT p (TD $ share s)) {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE -- -- This code is in the PUBLIC DOMAIN; you may copy it freely and use -- it for any purpose whatsoever. -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine {-# LINE 37 "templates/GenericTemplate.hs" #-} {-# LINE 47 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif {-# INLINE alexIndexInt16OffAddr #-} alexIndexInt16OffAddr (AlexA# arr) off = #ifdef WORDS_BIGENDIAN narrow16Int# i where i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) low = int2Word# (ord# (indexCharOffAddr# arr off')) off' = off *# 2# #else indexInt16OffAddr# arr off #endif {-# INLINE alexIndexInt32OffAddr #-} alexIndexInt32OffAddr (AlexA# arr) off = #ifdef WORDS_BIGENDIAN narrow32Int# i where !i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` (b2 `uncheckedShiftL#` 16#) `or#` (b1 `uncheckedShiftL#` 8#) `or#` b0) !b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) !b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) !b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) !b0 = int2Word# (ord# (indexCharOffAddr# arr off')) !off' = off *# 4# #else indexInt32OffAddr# arr off #endif #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else -- GHC >= 503, unsafeAt is available from Data.Array.Base. quickIndex = unsafeAt #endif -- ----------------------------------------------------------------------------- -- Main lexing routines data AlexReturn a = AlexEOF | AlexError !AlexInput | AlexSkip !AlexInput !Int | AlexToken !AlexInput !Int a -- alexScan :: AlexInput -> StartCode -> AlexReturn a alexScan input (I# (sc)) = alexScanUser undefined input (I# (sc)) alexScanUser user input (I# (sc)) = case alex_scan_tkn user input 0# input sc AlexNone of (AlexNone, input') -> case alexGetByte input of Nothing -> AlexEOF Just _ -> AlexError input' (AlexLastSkip input'' len, _) -> AlexSkip input'' len (AlexLastAcc k input''' len, _) -> AlexToken input''' len k -- Push the input through the DFA, remembering the most recent accepting -- state it encountered. alex_scan_tkn user orig_input len input s last_acc = input `seq` -- strict in the input let new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) in new_acc `seq` case alexGetByte input of Nothing -> (new_acc, input) Just (c, new_input) -> let (base) = alexIndexInt32OffAddr alex_base s ((I# (ord_c))) = fromIntegral c (offset) = (base +# ord_c) (check) = alexIndexInt16OffAddr alex_check offset (new_s) = if (offset >=# 0#) && (check ==# ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in case new_s of -1# -> (new_acc, input) -- on an error, we want to keep the input *before* the -- character that failed, not after. _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) -- note that the length is increased ONLY if this is the 1st byte in a char encoding) new_input new_s new_acc where check_accs [] = last_acc check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) check_accs (AlexAccPred a predx : rest) | predx user orig_input (I# (len)) input = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkipPred predx : rest) | predx user orig_input (I# (len)) input = AlexLastSkip input (I# (len)) check_accs (_ : rest) = check_accs rest data AlexLastAcc a = AlexNone | AlexLastAcc a !AlexInput !Int | AlexLastSkip !AlexInput !Int instance Functor AlexLastAcc where fmap f AlexNone = AlexNone fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z fmap f (AlexLastSkip x y) = AlexLastSkip x y data AlexAcc a user = AlexAcc a | AlexAccSkip | AlexAccPred a (AlexAccPred user) | AlexAccSkipPred (AlexAccPred user) type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool -- ----------------------------------------------------------------------------- -- Predicates on a rule alexAndPred p1 p2 user in1 len in2 = p1 user in1 len in2 && p2 user in1 len in2 --alexPrevCharIsPred :: Char -> AlexAccPred _ alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input alexPrevCharMatches f _ input _ _ = f (alexInputPrevChar input) --alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input --alexRightContext :: Int -> AlexAccPred _ alexRightContext (I# (sc)) user _ _ input = case alex_scan_tkn user input 0# input sc AlexNone of (AlexNone, _) -> False _ -> True -- TODO: there's no need to find the longest -- match when checking the right context, just -- the first match will do. -- used by wrappers iUnbox (I# (i)) = i BNFC-2.6.0.3/dist/build/bnfc/bnfc-tmp/ParBNF.hs0000644000000000000000000017610212100475636016655 0ustar0000000000000000{-# OPTIONS_GHC -w #-} {-# OPTIONS -fglasgow-exts -cpp #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} module ParBNF where import AbsBNF import LexBNF import ErrM import qualified Data.Array as Happy_Data_Array import qualified GHC.Exts as Happy_GHC_Exts -- parser produced by Happy Version 1.18.10 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 type HappyAny = Happy_GHC_Exts.Any #else type HappyAny = forall a . a #endif happyIn36 :: (String) -> (HappyAbsSyn ) happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn36 #-} happyOut36 :: (HappyAbsSyn ) -> (String) happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut36 #-} happyIn37 :: (Ident) -> (HappyAbsSyn ) happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn37 #-} happyOut37 :: (HappyAbsSyn ) -> (Ident) happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut37 #-} happyIn38 :: (Integer) -> (HappyAbsSyn ) happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn38 #-} happyOut38 :: (HappyAbsSyn ) -> (Integer) happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut38 #-} happyIn39 :: (Char) -> (HappyAbsSyn ) happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn39 #-} happyOut39 :: (HappyAbsSyn ) -> (Char) happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut39 #-} happyIn40 :: (Double) -> (HappyAbsSyn ) happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn40 #-} happyOut40 :: (HappyAbsSyn ) -> (Double) happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut40 #-} happyIn41 :: (LGrammar) -> (HappyAbsSyn ) happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn41 #-} happyOut41 :: (HappyAbsSyn ) -> (LGrammar) happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut41 #-} happyIn42 :: (LDef) -> (HappyAbsSyn ) happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn42 #-} happyOut42 :: (HappyAbsSyn ) -> (LDef) happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut42 #-} happyIn43 :: ([LDef]) -> (HappyAbsSyn ) happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn43 #-} happyOut43 :: (HappyAbsSyn ) -> ([LDef]) happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut43 #-} happyIn44 :: (Grammar) -> (HappyAbsSyn ) happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn44 #-} happyOut44 :: (HappyAbsSyn ) -> (Grammar) happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut44 #-} happyIn45 :: ([Def]) -> (HappyAbsSyn ) happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn45 #-} happyOut45 :: (HappyAbsSyn ) -> ([Def]) happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut45 #-} happyIn46 :: ([Item]) -> (HappyAbsSyn ) happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn46 #-} happyOut46 :: (HappyAbsSyn ) -> ([Item]) happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut46 #-} happyIn47 :: (Def) -> (HappyAbsSyn ) happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn47 #-} happyOut47 :: (HappyAbsSyn ) -> (Def) happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut47 #-} happyIn48 :: (Item) -> (HappyAbsSyn ) happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn48 #-} happyOut48 :: (HappyAbsSyn ) -> (Item) happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut48 #-} happyIn49 :: (Cat) -> (HappyAbsSyn ) happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn49 #-} happyOut49 :: (HappyAbsSyn ) -> (Cat) happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut49 #-} happyIn50 :: (Label) -> (HappyAbsSyn ) happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn50 #-} happyOut50 :: (HappyAbsSyn ) -> (Label) happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut50 #-} happyIn51 :: (LabelId) -> (HappyAbsSyn ) happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn51 #-} happyOut51 :: (HappyAbsSyn ) -> (LabelId) happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut51 #-} happyIn52 :: (ProfItem) -> (HappyAbsSyn ) happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn52 #-} happyOut52 :: (HappyAbsSyn ) -> (ProfItem) happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut52 #-} happyIn53 :: (IntList) -> (HappyAbsSyn ) happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn53 #-} happyOut53 :: (HappyAbsSyn ) -> (IntList) happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut53 #-} happyIn54 :: ([Integer]) -> (HappyAbsSyn ) happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn54 #-} happyOut54 :: (HappyAbsSyn ) -> ([Integer]) happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut54 #-} happyIn55 :: ([IntList]) -> (HappyAbsSyn ) happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn55 #-} happyOut55 :: (HappyAbsSyn ) -> ([IntList]) happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut55 #-} happyIn56 :: ([ProfItem]) -> (HappyAbsSyn ) happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn56 #-} happyOut56 :: (HappyAbsSyn ) -> ([ProfItem]) happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut56 #-} happyIn57 :: (Separation) -> (HappyAbsSyn ) happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn57 #-} happyOut57 :: (HappyAbsSyn ) -> (Separation) happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut57 #-} happyIn58 :: (Arg) -> (HappyAbsSyn ) happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn58 #-} happyOut58 :: (HappyAbsSyn ) -> (Arg) happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut58 #-} happyIn59 :: ([Arg]) -> (HappyAbsSyn ) happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn59 #-} happyOut59 :: (HappyAbsSyn ) -> ([Arg]) happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut59 #-} happyIn60 :: (Exp) -> (HappyAbsSyn ) happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn60 #-} happyOut60 :: (HappyAbsSyn ) -> (Exp) happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut60 #-} happyIn61 :: (Exp) -> (HappyAbsSyn ) happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn61 #-} happyOut61 :: (HappyAbsSyn ) -> (Exp) happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut61 #-} happyIn62 :: (Exp) -> (HappyAbsSyn ) happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn62 #-} happyOut62 :: (HappyAbsSyn ) -> (Exp) happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut62 #-} happyIn63 :: ([Exp]) -> (HappyAbsSyn ) happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn63 #-} happyOut63 :: (HappyAbsSyn ) -> ([Exp]) happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut63 #-} happyIn64 :: ([Exp]) -> (HappyAbsSyn ) happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn64 #-} happyOut64 :: (HappyAbsSyn ) -> ([Exp]) happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut64 #-} happyIn65 :: ([String]) -> (HappyAbsSyn ) happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn65 #-} happyOut65 :: (HappyAbsSyn ) -> ([String]) happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut65 #-} happyIn66 :: ([RHS]) -> (HappyAbsSyn ) happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn66 #-} happyOut66 :: (HappyAbsSyn ) -> ([RHS]) happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut66 #-} happyIn67 :: (RHS) -> (HappyAbsSyn ) happyIn67 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn67 #-} happyOut67 :: (HappyAbsSyn ) -> (RHS) happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut67 #-} happyIn68 :: (MinimumSize) -> (HappyAbsSyn ) happyIn68 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn68 #-} happyOut68 :: (HappyAbsSyn ) -> (MinimumSize) happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut68 #-} happyIn69 :: (Reg) -> (HappyAbsSyn ) happyIn69 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn69 #-} happyOut69 :: (HappyAbsSyn ) -> (Reg) happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut69 #-} happyIn70 :: (Reg) -> (HappyAbsSyn ) happyIn70 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn70 #-} happyOut70 :: (HappyAbsSyn ) -> (Reg) happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut70 #-} happyIn71 :: (Reg) -> (HappyAbsSyn ) happyIn71 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn71 #-} happyOut71 :: (HappyAbsSyn ) -> (Reg) happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut71 #-} happyIn72 :: (Reg) -> (HappyAbsSyn ) happyIn72 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn72 #-} happyOut72 :: (HappyAbsSyn ) -> (Reg) happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut72 #-} happyIn73 :: ([Ident]) -> (HappyAbsSyn ) happyIn73 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn73 #-} happyOut73 :: (HappyAbsSyn ) -> ([Ident]) happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut73 #-} happyInTok :: (Token) -> (HappyAbsSyn ) happyInTok x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyInTok #-} happyOutTok :: (HappyAbsSyn ) -> (Token) happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOutTok #-} happyActOffsets :: HappyAddr happyActOffsets = HappyA# "\x62\x00\x62\x00\x62\x00\x7c\x00\x7c\x00\x00\x00\x7c\x00\x5c\x00\x89\x00\x3d\x00\x3d\x00\xdd\x01\xd7\x01\xdc\x01\xd3\x01\xdb\x01\xbe\x00\xda\x01\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\xd9\x01\x00\x00\x00\x00\xd8\x01\x46\x00\x46\x00\x46\x00\x46\x00\xd6\x01\xd4\x01\x00\x00\xd5\x01\xd2\x01\x00\x00\x00\x00\x36\x00\xd1\x01\x8d\x01\xcf\x01\x46\x00\xce\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x01\x00\x00\x07\x00\xe1\xff\x01\x00\xcd\x01\x00\x00\x5c\x00\xcd\x01\xcd\x01\xcb\x01\xd0\x01\xca\x01\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\xc9\x01\xcc\x01\x00\x00\xc6\x01\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x08\x00\xc6\x01\xc6\x01\xc6\x01\xc6\x01\xfe\x00\x00\x00\xc6\x01\xc6\x01\xc7\x01\xc7\x01\xc8\x01\xc4\x01\xc5\x01\xc3\x01\xc0\x01\xc2\x01\xc1\x01\xbc\x01\xbc\x01\xbc\x01\x00\x00\xbc\x01\xbf\x01\xbd\x01\x00\x00\xb9\x01\x1f\x00\x00\x00\xb9\x01\x89\x00\x00\x00\xb9\x01\x00\x00\xb9\x01\xbe\x01\xbb\x01\xba\x01\xb8\x01\x89\x00\xb8\x01\x05\x00\x6f\x01\xae\x01\xb5\x01\xb7\x01\xb7\x01\xb3\x01\xf4\xff\xac\x01\xb6\x01\xaa\x01\x00\x00\x50\x00\xb2\x01\xa9\x01\x00\x00\xb1\x01\xa7\x01\x9b\x01\x9b\x01\x00\x00\x00\x00\x7c\x00\x62\x00\x9a\x01\x7c\x00\x00\x00\x46\x00\x89\x00\x89\x00\xaf\x01\x99\x01\x00\x00\x98\x01\x00\x00\xb0\x01\x00\x00\x96\x01\x00\x00\x96\x01\x92\x01\x89\x00\xa8\x01\xb4\x01\x00\x00\x64\x01\x00\x00\x9a\x00\x90\x01\xa4\x01\xa6\x01\xa6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x01\xad\x01\x08\x00\x08\x00\x00\x00\x8b\x01\x00\x00\x26\x01\x46\x00\x00\x00\x00\x00\x00\x00\x88\x01\xa0\x01\xab\x01\x46\x00\x46\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x01\x00\x00\x00\x00\xa2\x01\x00\x00\x00\x00\xf8\xff\x80\x01\x89\x00\x00\x00\x46\x00\x00\x00\x80\x01\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x01\xbe\x00\x08\x00\x00\x00\xa5\x01\xa1\x01\x97\x01\x00\x00\x5c\x00\x00\x00\x86\x01\x00\x00\x5c\x00\x00\x00\x7a\x01\x95\x01\x9d\x01\x00\x00\x00\x00"# happyGotoOffsets :: HappyAddr happyGotoOffsets = HappyA# "\x9e\x00\xbb\x00\xb9\x00\x65\x01\x75\x01\x93\x01\x77\x01\x89\x01\x7e\x01\x79\x01\xcc\x00\x91\x01\x8f\x01\xa0\x00\xe5\x00\x8a\x01\x87\x01\x92\x00\x84\x01\x3b\x01\x40\x01\x45\x01\x11\x01\xeb\x00\x91\x00\x44\x01\x78\x00\x6d\x01\x5b\x00\x17\x00\x42\x00\xb6\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x94\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x01\x00\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x4f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x01\xe6\x00\x00\x00\x00\x00\x00\x00\xf0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x8c\x01\x7b\x01\x83\x01\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x74\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x01\x68\x01\x57\x01\x51\x01\x06\x00\xbd\x00\x6d\x00\x00\x00\x56\x01\x17\x01\xe9\x00\x05\x01\x4f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\xa9\x00\x03\x00\x6e\x01\x00\x00\xae\x00\x24\x01\xfb\x00\x00\x00\x9f\x00\x00\x00\x4e\x00\x00\x00\x00\x00\x00\x00\xf7\x00\xc5\x00\xab\x00\xc3\x00\xf4\x00\x00\x00\x3d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\xaa\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x01\xe1\x00\x00\x00\x0d\x00\x42\x01\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x21\x00\x00\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\xa1\x00\xb5\x00\x00\x00\x1e\x00\x2c\x01\x57\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x16\x01\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x01\x00\x00\xef\xff\x02\x00\x4f\x01\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyDefActions :: HappyAddr happyDefActions = HappyA# "\xd5\xff\x00\x00\xd5\xff\xd1\xff\xd1\xff\xce\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\xff\xaa\xff\x00\x00\xa5\xff\x00\x00\xa1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x92\xff\x00\x00\xce\xff\xce\xff\x89\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\xff\x75\xff\x00\x00\xdd\xff\x7f\xff\x84\xff\x76\xff\x87\xff\x00\x00\x00\x00\x00\x00\x78\xff\x7c\xff\x80\xff\x7b\xff\x79\xff\x7a\xff\x00\x00\xdb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x8a\xff\x8b\xff\x00\x00\x00\x00\x8d\xff\x8f\xff\x00\x00\x98\xff\x9b\xff\x9a\xff\x99\xff\x97\xff\x91\xff\x9e\xff\x9c\xff\x00\x00\x00\x00\x92\xff\xdc\xff\xda\xff\x9b\xff\x94\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa7\xff\x00\x00\x00\x00\xa9\xff\x00\x00\xad\xff\xac\xff\x00\x00\x00\x00\x00\x00\xb4\xff\x00\x00\x00\x00\x00\x00\xb3\xff\x00\x00\xb8\xff\xb9\xff\x00\x00\x00\x00\xbc\xff\x00\x00\xbb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\xff\x89\xff\x00\x00\x00\x00\x00\x00\xd0\xff\x00\x00\xd2\xff\xb4\xff\xd4\xff\x00\x00\xd8\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\xd6\xff\x00\x00\xd5\xff\x00\x00\xd1\xff\xcd\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\xff\x00\x00\xbd\xff\x00\x00\xc6\xff\x00\x00\xa1\xff\xcb\xff\x00\x00\x00\x00\x00\x00\xb5\xff\xb7\xff\x00\x00\xb2\xff\x00\x00\xad\xff\x00\x00\xaa\xff\xaa\xff\xa6\xff\xa4\xff\xa3\xff\xa0\xff\x93\xff\x00\x00\x00\x00\x00\x00\x92\xff\x9d\xff\x00\x00\xce\xff\x88\xff\x00\x00\x83\xff\x82\xff\x81\xff\x00\x00\x00\x00\x00\x00\x00\x00\x85\xff\x77\xff\x7e\xff\x7d\xff\x86\xff\x8c\xff\x8e\xff\x90\xff\x9f\xff\x95\xff\x96\xff\x00\x00\xa8\xff\xae\xff\xab\xff\xb1\xff\x00\x00\xb6\xff\xba\xff\x00\x00\xc2\xff\xca\xff\x00\x00\x00\x00\x00\x00\xbe\xff\x00\x00\xce\xff\x00\x00\x00\x00\xc8\xff\xcf\xff\x74\xff\xd3\xff\xd7\xff\xc4\xff\xc5\xff\xc1\xff\xc7\xff\x00\x00\xa5\xff\x00\x00\xce\xff\x00\x00\x00\x00\x00\x00\xb0\xff\xcc\xff\xc0\xff\x89\xff\xce\xff\xc9\xff\xc3\xff\xad\xff\x00\x00\x00\x00\xaf\xff"# happyCheck :: HappyAddr happyCheck = HappyA# "\xff\xff\x0d\x00\x01\x00\x0b\x00\x01\x00\x01\x00\x01\x00\x01\x00\x27\x00\x01\x00\x03\x00\x04\x00\x0a\x00\x00\x00\x0d\x00\x20\x00\x2f\x00\x10\x00\x0d\x00\x0c\x00\x0f\x00\x0d\x00\x15\x00\x01\x00\x17\x00\x0a\x00\x03\x00\x1a\x00\x1b\x00\x29\x00\x2a\x00\x15\x00\x01\x00\x03\x00\x2a\x00\x2f\x00\x03\x00\x24\x00\x00\x00\x26\x00\x25\x00\x25\x00\x1d\x00\x25\x00\x0d\x00\x2c\x00\x0f\x00\x2a\x00\x2f\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2f\x00\x01\x00\x21\x00\x22\x00\x23\x00\x25\x00\x06\x00\x01\x00\x01\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0d\x00\x23\x00\x03\x00\x10\x00\x01\x00\x03\x00\x2a\x00\x0d\x00\x15\x00\x0f\x00\x17\x00\x00\x00\x02\x00\x1a\x00\x1b\x00\x16\x00\x0d\x00\x02\x00\x05\x00\x10\x00\x00\x00\x08\x00\x03\x00\x24\x00\x15\x00\x26\x00\x17\x00\x03\x00\x12\x00\x1a\x00\x1b\x00\x2c\x00\x01\x00\x12\x00\x23\x00\x21\x00\x2a\x00\x23\x00\x0d\x00\x24\x00\x1d\x00\x26\x00\x00\x00\x11\x00\x0d\x00\x13\x00\x0f\x00\x2c\x00\x11\x00\x12\x00\x13\x00\x14\x00\x21\x00\x16\x00\x23\x00\x18\x00\x19\x00\x21\x00\x01\x00\x23\x00\x1d\x00\x1e\x00\x1f\x00\x0a\x00\x21\x00\x22\x00\x29\x00\x2a\x00\x25\x00\x02\x00\x0d\x00\x1d\x00\x0f\x00\x2a\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x16\x00\x01\x00\x18\x00\x19\x00\x0d\x00\x1f\x00\x12\x00\x1d\x00\x1e\x00\x1f\x00\x02\x00\x21\x00\x22\x00\x01\x00\x01\x00\x00\x00\x02\x00\x05\x00\x06\x00\x07\x00\x2a\x00\x0d\x00\x16\x00\x0b\x00\x01\x00\x00\x00\x0e\x00\x0f\x00\x1d\x00\x06\x00\x07\x00\x03\x00\x12\x00\x2a\x00\x0b\x00\x03\x00\x01\x00\x0e\x00\x0f\x00\x03\x00\x01\x00\x11\x00\x01\x00\x13\x00\x01\x00\x06\x00\x07\x00\x06\x00\x0d\x00\x25\x00\x0b\x00\x02\x00\x0b\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x01\x00\x25\x00\x21\x00\x22\x00\x23\x00\x24\x00\x21\x00\x22\x00\x23\x00\x24\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0f\x00\x17\x00\x1f\x00\x25\x00\x21\x00\x25\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x01\x00\x11\x00\x00\x00\x13\x00\x18\x00\x19\x00\x1a\x00\x01\x00\x1c\x00\x18\x00\x19\x00\x1a\x00\x0d\x00\x1c\x00\x18\x00\x19\x00\x1a\x00\x01\x00\x1c\x00\x0d\x00\x20\x00\x1a\x00\x1b\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x01\x00\x1a\x00\x1b\x00\x2a\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x2f\x00\x18\x00\x19\x00\x1a\x00\x0d\x00\x0c\x00\x18\x00\x19\x00\x1a\x00\x0a\x00\x20\x00\x18\x00\x19\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1e\x00\x1f\x00\x0a\x00\x10\x00\x0a\x00\x00\x00\x01\x00\x14\x00\x01\x00\x18\x00\x19\x00\x1a\x00\x01\x00\x01\x00\x01\x00\x19\x00\x1a\x00\x0c\x00\x0d\x00\x01\x00\x0d\x00\x1a\x00\x1e\x00\x1f\x00\x1e\x00\x1f\x00\x0f\x00\x10\x00\x01\x00\x0b\x00\x00\x00\x14\x00\x0e\x00\x0f\x00\x08\x00\x08\x00\x09\x00\x01\x00\x0b\x00\x0d\x00\x01\x00\x0e\x00\x0f\x00\x01\x00\x01\x00\x09\x00\x01\x00\x0b\x00\x01\x00\x00\x00\x0e\x00\x0f\x00\x09\x00\x01\x00\x0b\x00\x0d\x00\x0b\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x00\x00\x01\x00\x0d\x00\x00\x00\x20\x00\x00\x00\x20\x00\x03\x00\x04\x00\x23\x00\x10\x00\x00\x00\x0c\x00\x0d\x00\x14\x00\x29\x00\x0c\x00\x10\x00\x17\x00\x15\x00\x0a\x00\x14\x00\x02\x00\x11\x00\x10\x00\x1c\x00\x0e\x00\x0d\x00\x2b\x00\x05\x00\x02\x00\x09\x00\x29\x00\x0e\x00\x09\x00\x0e\x00\x02\x00\x0e\x00\x02\x00\x28\x00\x0e\x00\x0e\x00\x0d\x00\x29\x00\x01\x00\x0e\x00\x07\x00\x09\x00\x08\x00\xff\xff\x2b\x00\x0a\x00\x2b\x00\xff\xff\x29\x00\x0a\x00\x29\x00\xff\xff\x2a\x00\x2a\x00\x07\x00\x05\x00\x08\x00\x05\x00\x01\x00\x2f\x00\x0e\x00\xff\xff\xff\xff\x05\x00\xff\xff\x22\x00\x2a\x00\x0d\x00\x1c\x00\x08\x00\x05\x00\xff\xff\xff\xff\x2f\x00\x2f\x00\x05\x00\x2f\x00\x01\x00\x2a\x00\x01\x00\x2a\x00\x0d\x00\xff\xff\x2a\x00\x29\x00\x0d\x00\x2a\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x2b\x00\xff\xff\x2f\x00\x29\x00\xff\xff\x27\x00\x2f\x00\x1c\x00\x2f\x00\xff\xff\x29\x00\x27\x00\x2f\x00\xff\xff\xff\xff\x2f\x00\x29\x00\x2f\x00\xff\xff\x2a\x00\x2f\x00\x29\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# happyTable :: HappyAddr happyTable = HappyA# "\x00\x00\x6d\x00\x2c\x00\xea\x00\x23\x00\x23\x00\x66\x00\x23\x00\xb9\x00\x4a\x00\xba\x00\xbb\x00\xf3\x00\x3e\x00\x2d\x00\xf4\x00\xff\xff\x2e\x00\x67\x00\xbc\x00\x68\x00\x4b\x00\x2f\x00\x23\x00\x30\x00\xef\x00\x26\x00\x31\x00\x32\x00\x23\x00\x26\x00\xf1\x00\xa5\x00\x26\x00\x26\x00\xff\xff\x26\x00\x33\x00\xe3\x00\x34\x00\xe0\x00\x8c\x00\xc6\x00\x9b\x00\x67\x00\x35\x00\x68\x00\x26\x00\xff\xff\x23\x00\x26\x00\x4c\x00\x35\x00\x4d\x00\xff\xff\x2c\x00\x27\x00\x36\x00\x29\x00\x24\x00\xc0\x00\x54\x00\x66\x00\x27\x00\x28\x00\x29\x00\xe6\x00\x2d\x00\xb7\x00\x26\x00\x2e\x00\x2c\x00\x26\x00\x26\x00\x67\x00\x2f\x00\x68\x00\x30\x00\x3e\x00\x5f\x00\x31\x00\x32\x00\xae\x00\x2d\x00\x5f\x00\x90\x00\x2e\x00\xe4\x00\x75\xff\x26\x00\x33\x00\x2f\x00\x34\x00\x30\x00\x26\x00\xf6\x00\x31\x00\x32\x00\x35\x00\x66\x00\xce\x00\x35\x00\xc0\x00\x26\x00\x29\x00\x6d\x00\x33\x00\xd9\x00\x34\x00\x3e\x00\x5c\x00\x67\x00\xcb\x00\x68\x00\x35\x00\x73\x00\x74\x00\x75\x00\x76\x00\xc4\x00\x77\x00\x29\x00\x78\x00\x79\x00\x37\x00\x66\x00\x29\x00\x7a\x00\x7b\x00\x7c\x00\x3a\x00\x7d\x00\x7e\x00\x23\x00\x26\x00\x89\x00\x5f\x00\x67\x00\x97\x00\x68\x00\x26\x00\x73\x00\x74\x00\x75\x00\x76\x00\x3e\x00\x77\x00\x54\x00\x78\x00\x79\x00\x6d\x00\x3b\x00\xa8\x00\x7a\x00\x7b\x00\x7c\x00\xd0\x00\x7d\x00\x7e\x00\x83\x00\xda\x00\xe8\x00\x5f\x00\x8a\x00\x84\x00\x8b\x00\x26\x00\xd1\x00\x55\x00\x86\x00\x83\x00\xd5\x00\x71\x00\x69\x00\x3f\x00\x84\x00\xe1\x00\x26\x00\x60\x00\x26\x00\x86\x00\x26\x00\x6a\x00\x71\x00\x69\x00\x26\x00\x83\x00\x5c\x00\x83\x00\xcc\x00\x63\x00\x84\x00\x85\x00\x89\x00\xe7\x00\x87\x00\x86\x00\xd4\x00\x86\x00\x71\x00\x69\x00\x71\x00\x69\x00\x9a\x00\x69\x00\x63\x00\x87\x00\x27\x00\x28\x00\x29\x00\xde\x00\x27\x00\x28\x00\x29\x00\xbe\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x64\x00\xd6\x00\x58\x00\x87\x00\x59\x00\x87\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x6a\x00\x5c\x00\xd7\x00\x5d\x00\x45\x00\x46\x00\x47\x00\x6a\x00\xc7\x00\x45\x00\x46\x00\x47\x00\xd3\x00\xb0\x00\x45\x00\x46\x00\x47\x00\x92\x00\x48\x00\xdc\x00\x93\x00\x4e\x00\xaf\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x6a\x00\x4e\x00\xb4\x00\x26\x00\xba\x00\xbb\x00\x4e\x00\x4f\x00\xff\xff\xf0\x00\x46\x00\x47\x00\xdd\x00\xbc\x00\xc8\x00\x46\x00\x47\x00\x3a\x00\x94\x00\xb1\x00\x46\x00\x47\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\xe5\x00\x3d\x00\x3a\x00\x59\x00\x3a\x00\x6d\x00\x6a\x00\xd1\x00\x6a\x00\x52\x00\x46\x00\x47\x00\x63\x00\x95\x00\x9d\x00\x51\x00\x47\x00\x91\x00\x6f\x00\x63\x00\x9c\x00\x50\x00\xc5\x00\x3d\x00\x3c\x00\x3d\x00\xa2\x00\x59\x00\x63\x00\xe2\x00\x9e\x00\xa3\x00\x71\x00\x69\x00\xa7\x00\x81\x00\x82\x00\x63\x00\x80\x00\xab\x00\x9f\x00\x71\x00\x69\x00\x6a\x00\x63\x00\xdf\x00\x63\x00\x80\x00\x63\x00\xac\x00\x71\x00\x69\x00\x7f\x00\x6a\x00\x80\x00\xa1\x00\x70\x00\x71\x00\x69\x00\x71\x00\x69\x00\x68\x00\x69\x00\x6d\x00\x6a\x00\x6b\x00\xad\x00\x38\x00\xbc\x00\x99\x00\xba\x00\xbb\x00\x9a\x00\x59\x00\xbd\x00\x6e\x00\x6f\x00\xab\x00\x23\x00\xbc\x00\x59\x00\x53\x00\x56\x00\x7e\x00\x5a\x00\xf9\x00\x61\x00\x62\x00\x3a\x00\xf8\x00\xf6\x00\x4c\x00\xee\x00\xef\x00\xf3\x00\x23\x00\xec\x00\xeb\x00\xed\x00\xc2\x00\xc3\x00\xca\x00\xc4\x00\xcb\x00\xce\x00\x5f\x00\x23\x00\x5c\x00\xd3\x00\xd9\x00\xdc\x00\x8e\x00\x00\x00\x4c\x00\x8f\x00\x4c\x00\x00\x00\x23\x00\x91\x00\x23\x00\x00\x00\x26\x00\x26\x00\xa1\x00\xa8\x00\xa7\x00\xaa\x00\x5c\x00\xff\xff\xa6\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x97\x00\x26\x00\xab\x00\x3a\x00\xb3\x00\xb6\x00\x00\x00\x00\x00\xff\xff\xff\xff\x90\x00\xff\xff\x5c\x00\x26\x00\x5c\x00\x26\x00\x5f\x00\x00\x00\x26\x00\x23\x00\x5f\x00\x26\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x4c\x00\x00\x00\xff\xff\x23\x00\x00\x00\xb7\x00\xff\xff\x3a\x00\xff\xff\x00\x00\x23\x00\xb9\x00\xff\xff\x00\x00\x00\x00\xff\xff\x23\x00\xff\xff\x00\x00\x26\x00\xff\xff\x23\x00\x00\x00\x26\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyReduceArr = Happy_Data_Array.array (33, 139) [ (33 , happyReduce_33), (34 , happyReduce_34), (35 , happyReduce_35), (36 , happyReduce_36), (37 , happyReduce_37), (38 , happyReduce_38), (39 , happyReduce_39), (40 , happyReduce_40), (41 , happyReduce_41), (42 , happyReduce_42), (43 , happyReduce_43), (44 , happyReduce_44), (45 , happyReduce_45), (46 , happyReduce_46), (47 , happyReduce_47), (48 , happyReduce_48), (49 , happyReduce_49), (50 , happyReduce_50), (51 , happyReduce_51), (52 , happyReduce_52), (53 , happyReduce_53), (54 , happyReduce_54), (55 , happyReduce_55), (56 , happyReduce_56), (57 , happyReduce_57), (58 , happyReduce_58), (59 , happyReduce_59), (60 , happyReduce_60), (61 , happyReduce_61), (62 , happyReduce_62), (63 , happyReduce_63), (64 , happyReduce_64), (65 , happyReduce_65), (66 , happyReduce_66), (67 , happyReduce_67), (68 , happyReduce_68), (69 , happyReduce_69), (70 , happyReduce_70), (71 , happyReduce_71), (72 , happyReduce_72), (73 , happyReduce_73), (74 , happyReduce_74), (75 , happyReduce_75), (76 , happyReduce_76), (77 , happyReduce_77), (78 , happyReduce_78), (79 , happyReduce_79), (80 , happyReduce_80), (81 , happyReduce_81), (82 , happyReduce_82), (83 , happyReduce_83), (84 , happyReduce_84), (85 , happyReduce_85), (86 , happyReduce_86), (87 , happyReduce_87), (88 , happyReduce_88), (89 , happyReduce_89), (90 , happyReduce_90), (91 , happyReduce_91), (92 , happyReduce_92), (93 , happyReduce_93), (94 , happyReduce_94), (95 , happyReduce_95), (96 , happyReduce_96), (97 , happyReduce_97), (98 , happyReduce_98), (99 , happyReduce_99), (100 , happyReduce_100), (101 , happyReduce_101), (102 , happyReduce_102), (103 , happyReduce_103), (104 , happyReduce_104), (105 , happyReduce_105), (106 , happyReduce_106), (107 , happyReduce_107), (108 , happyReduce_108), (109 , happyReduce_109), (110 , happyReduce_110), (111 , happyReduce_111), (112 , happyReduce_112), (113 , happyReduce_113), (114 , happyReduce_114), (115 , happyReduce_115), (116 , happyReduce_116), (117 , happyReduce_117), (118 , happyReduce_118), (119 , happyReduce_119), (120 , happyReduce_120), (121 , happyReduce_121), (122 , happyReduce_122), (123 , happyReduce_123), (124 , happyReduce_124), (125 , happyReduce_125), (126 , happyReduce_126), (127 , happyReduce_127), (128 , happyReduce_128), (129 , happyReduce_129), (130 , happyReduce_130), (131 , happyReduce_131), (132 , happyReduce_132), (133 , happyReduce_133), (134 , happyReduce_134), (135 , happyReduce_135), (136 , happyReduce_136), (137 , happyReduce_137), (138 , happyReduce_138), (139 , happyReduce_139) ] happy_n_terms = 48 :: Int happy_n_nonterms = 38 :: Int happyReduce_33 = happySpecReduce_1 0# happyReduction_33 happyReduction_33 happy_x_1 = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> happyIn36 (happy_var_1 )} happyReduce_34 = happySpecReduce_1 1# happyReduction_34 happyReduction_34 happy_x_1 = case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) -> happyIn37 (Ident happy_var_1 )} happyReduce_35 = happySpecReduce_1 2# happyReduction_35 happyReduction_35 happy_x_1 = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> happyIn38 ((read ( happy_var_1)) :: Integer )} happyReduce_36 = happySpecReduce_1 3# happyReduction_36 happyReduction_36 happy_x_1 = case happyOutTok happy_x_1 of { (PT _ (TC happy_var_1)) -> happyIn39 ((read ( happy_var_1)) :: Char )} happyReduce_37 = happySpecReduce_1 4# happyReduction_37 happyReduction_37 happy_x_1 = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> happyIn40 ((read ( happy_var_1)) :: Double )} happyReduce_38 = happySpecReduce_1 5# happyReduction_38 happyReduction_38 happy_x_1 = case happyOut43 happy_x_1 of { happy_var_1 -> happyIn41 (LGr happy_var_1 )} happyReduce_39 = happySpecReduce_1 6# happyReduction_39 happyReduction_39 happy_x_1 = case happyOut47 happy_x_1 of { happy_var_1 -> happyIn42 (DefAll happy_var_1 )} happyReduce_40 = happySpecReduce_3 6# happyReduction_40 happyReduction_40 happy_x_3 happy_x_2 happy_x_1 = case happyOut73 happy_x_1 of { happy_var_1 -> case happyOut47 happy_x_3 of { happy_var_3 -> happyIn42 (DefSome happy_var_1 happy_var_3 )}} happyReduce_41 = happySpecReduce_2 6# happyReduction_41 happyReduction_41 happy_x_2 happy_x_1 = case happyOut73 happy_x_2 of { happy_var_2 -> happyIn42 (LDefView happy_var_2 )} happyReduce_42 = happySpecReduce_0 7# happyReduction_42 happyReduction_42 = happyIn43 ([] ) happyReduce_43 = happySpecReduce_1 7# happyReduction_43 happyReduction_43 happy_x_1 = case happyOut42 happy_x_1 of { happy_var_1 -> happyIn43 ((:[]) happy_var_1 )} happyReduce_44 = happySpecReduce_3 7# happyReduction_44 happyReduction_44 happy_x_3 happy_x_2 happy_x_1 = case happyOut42 happy_x_1 of { happy_var_1 -> case happyOut43 happy_x_3 of { happy_var_3 -> happyIn43 ((:) happy_var_1 happy_var_3 )}} happyReduce_45 = happySpecReduce_1 8# happyReduction_45 happyReduction_45 happy_x_1 = case happyOut45 happy_x_1 of { happy_var_1 -> happyIn44 (Grammar happy_var_1 )} happyReduce_46 = happySpecReduce_0 9# happyReduction_46 happyReduction_46 = happyIn45 ([] ) happyReduce_47 = happySpecReduce_1 9# happyReduction_47 happyReduction_47 happy_x_1 = case happyOut47 happy_x_1 of { happy_var_1 -> happyIn45 ((:[]) happy_var_1 )} happyReduce_48 = happySpecReduce_3 9# happyReduction_48 happyReduction_48 happy_x_3 happy_x_2 happy_x_1 = case happyOut47 happy_x_1 of { happy_var_1 -> case happyOut45 happy_x_3 of { happy_var_3 -> happyIn45 ((:) happy_var_1 happy_var_3 )}} happyReduce_49 = happySpecReduce_0 10# happyReduction_49 happyReduction_49 = happyIn46 ([] ) happyReduce_50 = happySpecReduce_2 10# happyReduction_50 happyReduction_50 happy_x_2 happy_x_1 = case happyOut46 happy_x_1 of { happy_var_1 -> case happyOut48 happy_x_2 of { happy_var_2 -> happyIn46 (flip (:) happy_var_1 happy_var_2 )}} happyReduce_51 = happyReduce 5# 11# happyReduction_51 happyReduction_51 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut50 happy_x_1 of { happy_var_1 -> case happyOut49 happy_x_3 of { happy_var_3 -> case happyOut46 happy_x_5 of { happy_var_5 -> happyIn47 (Rule happy_var_1 happy_var_3 (reverse happy_var_5) ) `HappyStk` happyRest}}} happyReduce_52 = happySpecReduce_2 11# happyReduction_52 happyReduction_52 happy_x_2 happy_x_1 = case happyOut36 happy_x_2 of { happy_var_2 -> happyIn47 (Comment happy_var_2 )} happyReduce_53 = happySpecReduce_3 11# happyReduction_53 happyReduction_53 happy_x_3 happy_x_2 happy_x_1 = case happyOut36 happy_x_2 of { happy_var_2 -> case happyOut36 happy_x_3 of { happy_var_3 -> happyIn47 (Comments happy_var_2 happy_var_3 )}} happyReduce_54 = happyReduce 6# 11# happyReduction_54 happyReduction_54 (happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut50 happy_x_2 of { happy_var_2 -> case happyOut49 happy_x_4 of { happy_var_4 -> case happyOut46 happy_x_6 of { happy_var_6 -> happyIn47 (Internal happy_var_2 happy_var_4 (reverse happy_var_6) ) `HappyStk` happyRest}}} happyReduce_55 = happySpecReduce_3 11# happyReduction_55 happyReduction_55 happy_x_3 happy_x_2 happy_x_1 = case happyOut37 happy_x_2 of { happy_var_2 -> case happyOut72 happy_x_3 of { happy_var_3 -> happyIn47 (Token happy_var_2 happy_var_3 )}} happyReduce_56 = happyReduce 4# 11# happyReduction_56 happyReduction_56 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut37 happy_x_3 of { happy_var_3 -> case happyOut72 happy_x_4 of { happy_var_4 -> happyIn47 (PosToken happy_var_3 happy_var_4 ) `HappyStk` happyRest}} happyReduce_57 = happySpecReduce_2 11# happyReduction_57 happyReduction_57 happy_x_2 happy_x_1 = case happyOut73 happy_x_2 of { happy_var_2 -> happyIn47 (Entryp happy_var_2 )} happyReduce_58 = happyReduce 4# 11# happyReduction_58 happyReduction_58 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut68 happy_x_2 of { happy_var_2 -> case happyOut49 happy_x_3 of { happy_var_3 -> case happyOut36 happy_x_4 of { happy_var_4 -> happyIn47 (Separator happy_var_2 happy_var_3 happy_var_4 ) `HappyStk` happyRest}}} happyReduce_59 = happyReduce 4# 11# happyReduction_59 happyReduction_59 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut68 happy_x_2 of { happy_var_2 -> case happyOut49 happy_x_3 of { happy_var_3 -> case happyOut36 happy_x_4 of { happy_var_4 -> happyIn47 (Terminator happy_var_2 happy_var_3 happy_var_4 ) `HappyStk` happyRest}}} happyReduce_60 = happyReduce 6# 11# happyReduction_60 happyReduction_60 (happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut49 happy_x_2 of { happy_var_2 -> case happyOut36 happy_x_3 of { happy_var_3 -> case happyOut36 happy_x_4 of { happy_var_4 -> case happyOut57 happy_x_5 of { happy_var_5 -> case happyOut68 happy_x_6 of { happy_var_6 -> happyIn47 (Delimiters happy_var_2 happy_var_3 happy_var_4 happy_var_5 happy_var_6 ) `HappyStk` happyRest}}}}} happyReduce_61 = happySpecReduce_3 11# happyReduction_61 happyReduction_61 happy_x_3 happy_x_2 happy_x_1 = case happyOut37 happy_x_2 of { happy_var_2 -> case happyOut38 happy_x_3 of { happy_var_3 -> happyIn47 (Coercions happy_var_2 happy_var_3 )}} happyReduce_62 = happyReduce 4# 11# happyReduction_62 happyReduction_62 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut37 happy_x_2 of { happy_var_2 -> case happyOut66 happy_x_4 of { happy_var_4 -> happyIn47 (Rules happy_var_2 happy_var_4 ) `HappyStk` happyRest}} happyReduce_63 = happyReduce 5# 11# happyReduction_63 happyReduction_63 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut37 happy_x_2 of { happy_var_2 -> case happyOut59 happy_x_3 of { happy_var_3 -> case happyOut60 happy_x_5 of { happy_var_5 -> happyIn47 (Function happy_var_2 (reverse happy_var_3) happy_var_5 ) `HappyStk` happyRest}}} happyReduce_64 = happySpecReduce_2 11# happyReduction_64 happyReduction_64 happy_x_2 happy_x_1 = case happyOut65 happy_x_2 of { happy_var_2 -> happyIn47 (Layout happy_var_2 )} happyReduce_65 = happySpecReduce_3 11# happyReduction_65 happyReduction_65 happy_x_3 happy_x_2 happy_x_1 = case happyOut65 happy_x_3 of { happy_var_3 -> happyIn47 (LayoutStop happy_var_3 )} happyReduce_66 = happySpecReduce_2 11# happyReduction_66 happyReduction_66 happy_x_2 happy_x_1 = happyIn47 (LayoutTop ) happyReduce_67 = happySpecReduce_1 12# happyReduction_67 happyReduction_67 happy_x_1 = case happyOut36 happy_x_1 of { happy_var_1 -> happyIn48 (Terminal happy_var_1 )} happyReduce_68 = happySpecReduce_1 12# happyReduction_68 happyReduction_68 happy_x_1 = case happyOut49 happy_x_1 of { happy_var_1 -> happyIn48 (NTerminal happy_var_1 )} happyReduce_69 = happySpecReduce_3 13# happyReduction_69 happyReduction_69 happy_x_3 happy_x_2 happy_x_1 = case happyOut49 happy_x_2 of { happy_var_2 -> happyIn49 (ListCat happy_var_2 )} happyReduce_70 = happySpecReduce_1 13# happyReduction_70 happyReduction_70 happy_x_1 = case happyOut37 happy_x_1 of { happy_var_1 -> happyIn49 (IdCat happy_var_1 )} happyReduce_71 = happySpecReduce_1 14# happyReduction_71 happyReduction_71 happy_x_1 = case happyOut51 happy_x_1 of { happy_var_1 -> happyIn50 (LabNoP happy_var_1 )} happyReduce_72 = happySpecReduce_2 14# happyReduction_72 happyReduction_72 happy_x_2 happy_x_1 = case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut56 happy_x_2 of { happy_var_2 -> happyIn50 (LabP happy_var_1 happy_var_2 )}} happyReduce_73 = happySpecReduce_3 14# happyReduction_73 happyReduction_73 happy_x_3 happy_x_2 happy_x_1 = case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut51 happy_x_2 of { happy_var_2 -> case happyOut56 happy_x_3 of { happy_var_3 -> happyIn50 (LabPF happy_var_1 happy_var_2 happy_var_3 )}}} happyReduce_74 = happySpecReduce_2 14# happyReduction_74 happyReduction_74 happy_x_2 happy_x_1 = case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut51 happy_x_2 of { happy_var_2 -> happyIn50 (LabF happy_var_1 happy_var_2 )}} happyReduce_75 = happySpecReduce_1 15# happyReduction_75 happyReduction_75 happy_x_1 = case happyOut37 happy_x_1 of { happy_var_1 -> happyIn51 (Id happy_var_1 )} happyReduce_76 = happySpecReduce_1 15# happyReduction_76 happyReduction_76 happy_x_1 = happyIn51 (Wild ) happyReduce_77 = happySpecReduce_2 15# happyReduction_77 happyReduction_77 happy_x_2 happy_x_1 = happyIn51 (ListE ) happyReduce_78 = happySpecReduce_3 15# happyReduction_78 happyReduction_78 happy_x_3 happy_x_2 happy_x_1 = happyIn51 (ListCons ) happyReduce_79 = happyReduce 5# 15# happyReduction_79 happyReduction_79 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = happyIn51 (ListOne ) `HappyStk` happyRest happyReduce_80 = happyReduce 9# 16# happyReduction_80 happyReduction_80 (happy_x_9 `HappyStk` happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut55 happy_x_3 of { happy_var_3 -> case happyOut54 happy_x_7 of { happy_var_7 -> happyIn52 (ProfIt happy_var_3 happy_var_7 ) `HappyStk` happyRest}} happyReduce_81 = happySpecReduce_3 17# happyReduction_81 happyReduction_81 happy_x_3 happy_x_2 happy_x_1 = case happyOut54 happy_x_2 of { happy_var_2 -> happyIn53 (Ints happy_var_2 )} happyReduce_82 = happySpecReduce_0 18# happyReduction_82 happyReduction_82 = happyIn54 ([] ) happyReduce_83 = happySpecReduce_1 18# happyReduction_83 happyReduction_83 happy_x_1 = case happyOut38 happy_x_1 of { happy_var_1 -> happyIn54 ((:[]) happy_var_1 )} happyReduce_84 = happySpecReduce_3 18# happyReduction_84 happyReduction_84 happy_x_3 happy_x_2 happy_x_1 = case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut54 happy_x_3 of { happy_var_3 -> happyIn54 ((:) happy_var_1 happy_var_3 )}} happyReduce_85 = happySpecReduce_0 19# happyReduction_85 happyReduction_85 = happyIn55 ([] ) happyReduce_86 = happySpecReduce_1 19# happyReduction_86 happyReduction_86 happy_x_1 = case happyOut53 happy_x_1 of { happy_var_1 -> happyIn55 ((:[]) happy_var_1 )} happyReduce_87 = happySpecReduce_3 19# happyReduction_87 happyReduction_87 happy_x_3 happy_x_2 happy_x_1 = case happyOut53 happy_x_1 of { happy_var_1 -> case happyOut55 happy_x_3 of { happy_var_3 -> happyIn55 ((:) happy_var_1 happy_var_3 )}} happyReduce_88 = happySpecReduce_1 20# happyReduction_88 happyReduction_88 happy_x_1 = case happyOut52 happy_x_1 of { happy_var_1 -> happyIn56 ((:[]) happy_var_1 )} happyReduce_89 = happySpecReduce_2 20# happyReduction_89 happyReduction_89 happy_x_2 happy_x_1 = case happyOut52 happy_x_1 of { happy_var_1 -> case happyOut56 happy_x_2 of { happy_var_2 -> happyIn56 ((:) happy_var_1 happy_var_2 )}} happyReduce_90 = happySpecReduce_0 21# happyReduction_90 happyReduction_90 = happyIn57 (SepNone ) happyReduce_91 = happySpecReduce_2 21# happyReduction_91 happyReduction_91 happy_x_2 happy_x_1 = case happyOut36 happy_x_2 of { happy_var_2 -> happyIn57 (SepTerm happy_var_2 )} happyReduce_92 = happySpecReduce_2 21# happyReduction_92 happyReduction_92 happy_x_2 happy_x_1 = case happyOut36 happy_x_2 of { happy_var_2 -> happyIn57 (SepSepar happy_var_2 )} happyReduce_93 = happySpecReduce_1 22# happyReduction_93 happyReduction_93 happy_x_1 = case happyOut37 happy_x_1 of { happy_var_1 -> happyIn58 (Arg happy_var_1 )} happyReduce_94 = happySpecReduce_0 23# happyReduction_94 happyReduction_94 = happyIn59 ([] ) happyReduce_95 = happySpecReduce_2 23# happyReduction_95 happyReduction_95 happy_x_2 happy_x_1 = case happyOut59 happy_x_1 of { happy_var_1 -> case happyOut58 happy_x_2 of { happy_var_2 -> happyIn59 (flip (:) happy_var_1 happy_var_2 )}} happyReduce_96 = happySpecReduce_3 24# happyReduction_96 happyReduction_96 happy_x_3 happy_x_2 happy_x_1 = case happyOut61 happy_x_1 of { happy_var_1 -> case happyOut60 happy_x_3 of { happy_var_3 -> happyIn60 (Cons happy_var_1 happy_var_3 )}} happyReduce_97 = happySpecReduce_1 24# happyReduction_97 happyReduction_97 happy_x_1 = case happyOut61 happy_x_1 of { happy_var_1 -> happyIn60 (happy_var_1 )} happyReduce_98 = happySpecReduce_2 25# happyReduction_98 happyReduction_98 happy_x_2 happy_x_1 = case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut63 happy_x_2 of { happy_var_2 -> happyIn61 (App happy_var_1 happy_var_2 )}} happyReduce_99 = happySpecReduce_1 25# happyReduction_99 happyReduction_99 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> happyIn61 (happy_var_1 )} happyReduce_100 = happySpecReduce_1 26# happyReduction_100 happyReduction_100 happy_x_1 = case happyOut37 happy_x_1 of { happy_var_1 -> happyIn62 (Var happy_var_1 )} happyReduce_101 = happySpecReduce_1 26# happyReduction_101 happyReduction_101 happy_x_1 = case happyOut38 happy_x_1 of { happy_var_1 -> happyIn62 (LitInt happy_var_1 )} happyReduce_102 = happySpecReduce_1 26# happyReduction_102 happyReduction_102 happy_x_1 = case happyOut39 happy_x_1 of { happy_var_1 -> happyIn62 (LitChar happy_var_1 )} happyReduce_103 = happySpecReduce_1 26# happyReduction_103 happyReduction_103 happy_x_1 = case happyOut36 happy_x_1 of { happy_var_1 -> happyIn62 (LitString happy_var_1 )} happyReduce_104 = happySpecReduce_1 26# happyReduction_104 happyReduction_104 happy_x_1 = case happyOut40 happy_x_1 of { happy_var_1 -> happyIn62 (LitDouble happy_var_1 )} happyReduce_105 = happySpecReduce_3 26# happyReduction_105 happyReduction_105 happy_x_3 happy_x_2 happy_x_1 = case happyOut64 happy_x_2 of { happy_var_2 -> happyIn62 (List happy_var_2 )} happyReduce_106 = happySpecReduce_3 26# happyReduction_106 happyReduction_106 happy_x_3 happy_x_2 happy_x_1 = case happyOut60 happy_x_2 of { happy_var_2 -> happyIn62 (happy_var_2 )} happyReduce_107 = happySpecReduce_1 27# happyReduction_107 happyReduction_107 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> happyIn63 ((:[]) happy_var_1 )} happyReduce_108 = happySpecReduce_2 27# happyReduction_108 happyReduction_108 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut63 happy_x_2 of { happy_var_2 -> happyIn63 ((:) happy_var_1 happy_var_2 )}} happyReduce_109 = happySpecReduce_0 28# happyReduction_109 happyReduction_109 = happyIn64 ([] ) happyReduce_110 = happySpecReduce_1 28# happyReduction_110 happyReduction_110 happy_x_1 = case happyOut60 happy_x_1 of { happy_var_1 -> happyIn64 ((:[]) happy_var_1 )} happyReduce_111 = happySpecReduce_3 28# happyReduction_111 happyReduction_111 happy_x_3 happy_x_2 happy_x_1 = case happyOut60 happy_x_1 of { happy_var_1 -> case happyOut64 happy_x_3 of { happy_var_3 -> happyIn64 ((:) happy_var_1 happy_var_3 )}} happyReduce_112 = happySpecReduce_1 29# happyReduction_112 happyReduction_112 happy_x_1 = case happyOut36 happy_x_1 of { happy_var_1 -> happyIn65 ((:[]) happy_var_1 )} happyReduce_113 = happySpecReduce_3 29# happyReduction_113 happyReduction_113 happy_x_3 happy_x_2 happy_x_1 = case happyOut36 happy_x_1 of { happy_var_1 -> case happyOut65 happy_x_3 of { happy_var_3 -> happyIn65 ((:) happy_var_1 happy_var_3 )}} happyReduce_114 = happySpecReduce_1 30# happyReduction_114 happyReduction_114 happy_x_1 = case happyOut67 happy_x_1 of { happy_var_1 -> happyIn66 ((:[]) happy_var_1 )} happyReduce_115 = happySpecReduce_3 30# happyReduction_115 happyReduction_115 happy_x_3 happy_x_2 happy_x_1 = case happyOut67 happy_x_1 of { happy_var_1 -> case happyOut66 happy_x_3 of { happy_var_3 -> happyIn66 ((:) happy_var_1 happy_var_3 )}} happyReduce_116 = happySpecReduce_1 31# happyReduction_116 happyReduction_116 happy_x_1 = case happyOut46 happy_x_1 of { happy_var_1 -> happyIn67 (RHS (reverse happy_var_1) )} happyReduce_117 = happySpecReduce_1 32# happyReduction_117 happyReduction_117 happy_x_1 = happyIn68 (MNonempty ) happyReduce_118 = happySpecReduce_0 32# happyReduction_118 happyReduction_118 = happyIn68 (MEmpty ) happyReduce_119 = happySpecReduce_2 33# happyReduction_119 happyReduction_119 happy_x_2 happy_x_1 = case happyOut69 happy_x_1 of { happy_var_1 -> case happyOut71 happy_x_2 of { happy_var_2 -> happyIn69 (RSeq happy_var_1 happy_var_2 )}} happyReduce_120 = happySpecReduce_1 33# happyReduction_120 happyReduction_120 happy_x_1 = case happyOut71 happy_x_1 of { happy_var_1 -> happyIn69 (happy_var_1 )} happyReduce_121 = happySpecReduce_3 34# happyReduction_121 happyReduction_121 happy_x_3 happy_x_2 happy_x_1 = case happyOut70 happy_x_1 of { happy_var_1 -> case happyOut69 happy_x_3 of { happy_var_3 -> happyIn70 (RAlt happy_var_1 happy_var_3 )}} happyReduce_122 = happySpecReduce_3 34# happyReduction_122 happyReduction_122 happy_x_3 happy_x_2 happy_x_1 = case happyOut69 happy_x_1 of { happy_var_1 -> case happyOut69 happy_x_3 of { happy_var_3 -> happyIn70 (RMinus happy_var_1 happy_var_3 )}} happyReduce_123 = happySpecReduce_1 34# happyReduction_123 happyReduction_123 happy_x_1 = case happyOut69 happy_x_1 of { happy_var_1 -> happyIn70 (happy_var_1 )} happyReduce_124 = happySpecReduce_2 35# happyReduction_124 happyReduction_124 happy_x_2 happy_x_1 = case happyOut71 happy_x_1 of { happy_var_1 -> happyIn71 (RStar happy_var_1 )} happyReduce_125 = happySpecReduce_2 35# happyReduction_125 happyReduction_125 happy_x_2 happy_x_1 = case happyOut71 happy_x_1 of { happy_var_1 -> happyIn71 (RPlus happy_var_1 )} happyReduce_126 = happySpecReduce_2 35# happyReduction_126 happyReduction_126 happy_x_2 happy_x_1 = case happyOut71 happy_x_1 of { happy_var_1 -> happyIn71 (ROpt happy_var_1 )} happyReduce_127 = happySpecReduce_1 35# happyReduction_127 happyReduction_127 happy_x_1 = happyIn71 (REps ) happyReduce_128 = happySpecReduce_1 35# happyReduction_128 happyReduction_128 happy_x_1 = case happyOut39 happy_x_1 of { happy_var_1 -> happyIn71 (RChar happy_var_1 )} happyReduce_129 = happySpecReduce_3 35# happyReduction_129 happyReduction_129 happy_x_3 happy_x_2 happy_x_1 = case happyOut36 happy_x_2 of { happy_var_2 -> happyIn71 (RAlts happy_var_2 )} happyReduce_130 = happySpecReduce_3 35# happyReduction_130 happyReduction_130 happy_x_3 happy_x_2 happy_x_1 = case happyOut36 happy_x_2 of { happy_var_2 -> happyIn71 (RSeqs happy_var_2 )} happyReduce_131 = happySpecReduce_1 35# happyReduction_131 happyReduction_131 happy_x_1 = happyIn71 (RDigit ) happyReduce_132 = happySpecReduce_1 35# happyReduction_132 happyReduction_132 happy_x_1 = happyIn71 (RLetter ) happyReduce_133 = happySpecReduce_1 35# happyReduction_133 happyReduction_133 happy_x_1 = happyIn71 (RUpper ) happyReduce_134 = happySpecReduce_1 35# happyReduction_134 happyReduction_134 happy_x_1 = happyIn71 (RLower ) happyReduce_135 = happySpecReduce_1 35# happyReduction_135 happyReduction_135 happy_x_1 = happyIn71 (RAny ) happyReduce_136 = happySpecReduce_3 35# happyReduction_136 happyReduction_136 happy_x_3 happy_x_2 happy_x_1 = case happyOut72 happy_x_2 of { happy_var_2 -> happyIn71 (happy_var_2 )} happyReduce_137 = happySpecReduce_1 36# happyReduction_137 happyReduction_137 happy_x_1 = case happyOut70 happy_x_1 of { happy_var_1 -> happyIn72 (happy_var_1 )} happyReduce_138 = happySpecReduce_1 37# happyReduction_138 happyReduction_138 happy_x_1 = case happyOut37 happy_x_1 of { happy_var_1 -> happyIn73 ((:[]) happy_var_1 )} happyReduce_139 = happySpecReduce_3 37# happyReduction_139 happyReduction_139 happy_x_3 happy_x_2 happy_x_1 = case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut73 happy_x_3 of { happy_var_3 -> happyIn73 ((:) happy_var_1 happy_var_3 )}} happyNewToken action sts stk [] = happyDoAction 47# notHappyAtAll action sts stk [] happyNewToken action sts stk (tk:tks) = let cont i = happyDoAction i tk action sts stk tks in case tk of { PT _ (TS _ 1) -> cont 1#; PT _ (TS _ 2) -> cont 2#; PT _ (TS _ 3) -> cont 3#; PT _ (TS _ 4) -> cont 4#; PT _ (TS _ 5) -> cont 5#; PT _ (TS _ 6) -> cont 6#; PT _ (TS _ 7) -> cont 7#; PT _ (TS _ 8) -> cont 8#; PT _ (TS _ 9) -> cont 9#; PT _ (TS _ 10) -> cont 10#; PT _ (TS _ 11) -> cont 11#; PT _ (TS _ 12) -> cont 12#; PT _ (TS _ 13) -> cont 13#; PT _ (TS _ 14) -> cont 14#; PT _ (TS _ 15) -> cont 15#; PT _ (TS _ 16) -> cont 16#; PT _ (TS _ 17) -> cont 17#; PT _ (TS _ 18) -> cont 18#; PT _ (TS _ 19) -> cont 19#; PT _ (TS _ 20) -> cont 20#; PT _ (TS _ 21) -> cont 21#; PT _ (TS _ 22) -> cont 22#; PT _ (TS _ 23) -> cont 23#; PT _ (TS _ 24) -> cont 24#; PT _ (TS _ 25) -> cont 25#; PT _ (TS _ 26) -> cont 26#; PT _ (TS _ 27) -> cont 27#; PT _ (TS _ 28) -> cont 28#; PT _ (TS _ 29) -> cont 29#; PT _ (TS _ 30) -> cont 30#; PT _ (TS _ 31) -> cont 31#; PT _ (TS _ 32) -> cont 32#; PT _ (TS _ 33) -> cont 33#; PT _ (TS _ 34) -> cont 34#; PT _ (TS _ 35) -> cont 35#; PT _ (TS _ 36) -> cont 36#; PT _ (TS _ 37) -> cont 37#; PT _ (TS _ 38) -> cont 38#; PT _ (TS _ 39) -> cont 39#; PT _ (TS _ 40) -> cont 40#; PT _ (TL happy_dollar_dollar) -> cont 41#; PT _ (TV happy_dollar_dollar) -> cont 42#; PT _ (TI happy_dollar_dollar) -> cont 43#; PT _ (TC happy_dollar_dollar) -> cont 44#; PT _ (TD happy_dollar_dollar) -> cont 45#; _ -> cont 46#; _ -> happyError' (tk:tks) } happyError_ 47# tk tks = happyError' tks happyError_ _ tk tks = happyError' (tk:tks) happyThen :: () => Err a -> (a -> Err b) -> Err b happyThen = (thenM) happyReturn :: () => a -> Err a happyReturn = (returnM) happyThen1 m k tks = (thenM) m (\a -> k a tks) happyReturn1 :: () => a -> b -> Err a happyReturn1 = \a tks -> (returnM) a happyError' :: () => [(Token)] -> Err a happyError' = happyError pLGrammar tks = happySomeParser where happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut41 x)) pLDef tks = happySomeParser where happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut42 x)) pListLDef tks = happySomeParser where happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut43 x)) pGrammar tks = happySomeParser where happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (happyOut44 x)) pListDef tks = happySomeParser where happySomeParser = happyThen (happyParse 4# tks) (\x -> happyReturn (happyOut45 x)) pListItem tks = happySomeParser where happySomeParser = happyThen (happyParse 5# tks) (\x -> happyReturn (happyOut46 x)) pDef tks = happySomeParser where happySomeParser = happyThen (happyParse 6# tks) (\x -> happyReturn (happyOut47 x)) pItem tks = happySomeParser where happySomeParser = happyThen (happyParse 7# tks) (\x -> happyReturn (happyOut48 x)) pCat tks = happySomeParser where happySomeParser = happyThen (happyParse 8# tks) (\x -> happyReturn (happyOut49 x)) pLabel tks = happySomeParser where happySomeParser = happyThen (happyParse 9# tks) (\x -> happyReturn (happyOut50 x)) pLabelId tks = happySomeParser where happySomeParser = happyThen (happyParse 10# tks) (\x -> happyReturn (happyOut51 x)) pProfItem tks = happySomeParser where happySomeParser = happyThen (happyParse 11# tks) (\x -> happyReturn (happyOut52 x)) pIntList tks = happySomeParser where happySomeParser = happyThen (happyParse 12# tks) (\x -> happyReturn (happyOut53 x)) pListInteger tks = happySomeParser where happySomeParser = happyThen (happyParse 13# tks) (\x -> happyReturn (happyOut54 x)) pListIntList tks = happySomeParser where happySomeParser = happyThen (happyParse 14# tks) (\x -> happyReturn (happyOut55 x)) pListProfItem tks = happySomeParser where happySomeParser = happyThen (happyParse 15# tks) (\x -> happyReturn (happyOut56 x)) pSeparation tks = happySomeParser where happySomeParser = happyThen (happyParse 16# tks) (\x -> happyReturn (happyOut57 x)) pArg tks = happySomeParser where happySomeParser = happyThen (happyParse 17# tks) (\x -> happyReturn (happyOut58 x)) pListArg tks = happySomeParser where happySomeParser = happyThen (happyParse 18# tks) (\x -> happyReturn (happyOut59 x)) pExp tks = happySomeParser where happySomeParser = happyThen (happyParse 19# tks) (\x -> happyReturn (happyOut60 x)) pExp1 tks = happySomeParser where happySomeParser = happyThen (happyParse 20# tks) (\x -> happyReturn (happyOut61 x)) pExp2 tks = happySomeParser where happySomeParser = happyThen (happyParse 21# tks) (\x -> happyReturn (happyOut62 x)) pListExp2 tks = happySomeParser where happySomeParser = happyThen (happyParse 22# tks) (\x -> happyReturn (happyOut63 x)) pListExp tks = happySomeParser where happySomeParser = happyThen (happyParse 23# tks) (\x -> happyReturn (happyOut64 x)) pListString tks = happySomeParser where happySomeParser = happyThen (happyParse 24# tks) (\x -> happyReturn (happyOut65 x)) pListRHS tks = happySomeParser where happySomeParser = happyThen (happyParse 25# tks) (\x -> happyReturn (happyOut66 x)) pRHS tks = happySomeParser where happySomeParser = happyThen (happyParse 26# tks) (\x -> happyReturn (happyOut67 x)) pMinimumSize tks = happySomeParser where happySomeParser = happyThen (happyParse 27# tks) (\x -> happyReturn (happyOut68 x)) pReg2 tks = happySomeParser where happySomeParser = happyThen (happyParse 28# tks) (\x -> happyReturn (happyOut69 x)) pReg1 tks = happySomeParser where happySomeParser = happyThen (happyParse 29# tks) (\x -> happyReturn (happyOut70 x)) pReg3 tks = happySomeParser where happySomeParser = happyThen (happyParse 30# tks) (\x -> happyReturn (happyOut71 x)) pReg tks = happySomeParser where happySomeParser = happyThen (happyParse 31# tks) (\x -> happyReturn (happyOut72 x)) pListIdent tks = happySomeParser where happySomeParser = happyThen (happyParse 32# tks) (\x -> happyReturn (happyOut73 x)) happySeq = happyDontSeq returnM :: a -> Err a returnM = return thenM :: Err a -> (a -> Err b) -> Err b thenM = (>>=) happyError :: [Token] -> Err a happyError ts = Bad $ "syntax error at " ++ tokenPos ts ++ case ts of [] -> [] [Err _] -> " due to lexer error" _ -> " before " ++ unwords (map (id . prToken) (take 4 ts)) myLexer = tokens {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp {-# LINE 30 "templates/GenericTemplate.hs" #-} data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList {-# LINE 51 "templates/GenericTemplate.hs" #-} {-# LINE 61 "templates/GenericTemplate.hs" #-} {-# LINE 70 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) ----------------------------------------------------------------------------- -- starting the parse happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll ----------------------------------------------------------------------------- -- Accepting the parse -- If the current token is 0#, it means we've just accepted a partial -- parse (a %partial parser). We must ignore the saved token on the top of -- the stack in this case. happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action happyDoAction i tk st = {- nothing -} case action of 0# -> {- nothing -} happyFail i tk st -1# -> {- nothing -} happyAccept i tk st n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} (happyReduceArr Happy_Data_Array.! rule) i tk st where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) n -> {- nothing -} happyShift new_state i tk st where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) where (off) = indexShortOffAddr happyActOffsets st (off_i) = (off Happy_GHC_Exts.+# i) check = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#)) then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) else False (action) | check = indexShortOffAddr happyTable off_i | otherwise = indexShortOffAddr happyDefActions st {-# LINE 130 "templates/GenericTemplate.hs" #-} indexShortOffAddr (HappyA# arr) off = Happy_GHC_Exts.narrow16Int# i where i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) off' = off Happy_GHC_Exts.*# 2# data HappyAddr = HappyA# Happy_GHC_Exts.Addr# ----------------------------------------------------------------------------- -- HappyState data type (not arrays) {-# LINE 163 "templates/GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- Shifting a token happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in -- trace "shifting the error token" $ happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) happyShift new_state i tk st sts stk = happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) -- happyReduce is specialised for the common cases. happySpecReduce_0 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_0 nt fn j tk st@((action)) sts stk = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) happySpecReduce_1 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') = let r = fn v1 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happySpecReduce_2 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') = let r = fn v1 v2 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happySpecReduce_3 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') = let r = fn v1 v2 v3 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happyReduce k i fn 0# tk st sts stk = happyFail 0# tk st sts stk happyReduce k nt fn j tk st sts stk = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of sts1@((HappyCons (st1@(action)) (_))) -> let r = fn stk in -- it doesn't hurt to always seq here... happyDoSeq r (happyGoto nt j tk st1 sts1 r) happyMonadReduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonadReduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk happyMonad2Reduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk (off) = indexShortOffAddr happyGotoOffsets st1 (off_i) = (off Happy_GHC_Exts.+# nt) (new_state) = indexShortOffAddr happyTable off_i happyDrop 0# l = l happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t happyDropStk 0# l = l happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs ----------------------------------------------------------------------------- -- Moving to a new state after a reduction happyGoto nt j tk st = {- nothing -} happyDoAction j tk new_state where (off) = indexShortOffAddr happyGotoOffsets st (off_i) = (off Happy_GHC_Exts.+# nt) (new_state) = indexShortOffAddr happyTable off_i ----------------------------------------------------------------------------- -- Error recovery (0# is the error token) -- parse error if we are in recovery and we fail again happyFail 0# tk old_st _ stk@(x `HappyStk` _) = let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in -- trace "failing" $ happyError_ i tk {- We don't need state discarding for our restricted implementation of "error". In fact, it can cause some bogus parses, so I've disabled it for now --SDM -- discard a state happyFail 0# tk old_st (HappyCons ((action)) (sts)) (saved_tok `HappyStk` _ `HappyStk` stk) = -- trace ("discarding state, depth " ++ show (length stk)) $ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) -} -- Enter error recovery: generate an error token, -- save the old token and carry on. happyFail i tk (action) sts stk = -- trace "entering error recovery" $ happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) -- Internal happy errors: notHappyAtAll :: a notHappyAtAll = error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions happyTcHack :: Happy_GHC_Exts.Int# -> a -> a happyTcHack x y = y {-# INLINE happyTcHack #-} ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits -- happySeq = happyDoSeq -- otherwise it emits -- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b happyDontSeq a b = b ----------------------------------------------------------------------------- -- Don't inline any functions from the template. GHC has a nasty habit -- of deciding to inline happyGoto everywhere, which increases the size of -- the generated parser quite a bit. {-# NOINLINE happyDoAction #-} {-# NOINLINE happyTable #-} {-# NOINLINE happyCheck #-} {-# NOINLINE happyActOffsets #-} {-# NOINLINE happyGotoOffsets #-} {-# NOINLINE happyDefActions #-} {-# NOINLINE happyShift #-} {-# NOINLINE happySpecReduce_0 #-} {-# NOINLINE happySpecReduce_1 #-} {-# NOINLINE happySpecReduce_2 #-} {-# NOINLINE happySpecReduce_3 #-} {-# NOINLINE happyReduce #-} {-# NOINLINE happyMonadReduce #-} {-# NOINLINE happyGoto #-} {-# NOINLINE happyFail #-} -- end of Happy Template. BNFC-2.6.0.3/src/0000755000000000000000000000000012100475635011350 5ustar0000000000000000BNFC-2.6.0.3/src/Utils.hs0000644000000000000000000001213412100475634013004 0ustar0000000000000000{- BNF Converter: Abstract syntax Copyright (C) 2004 Author: Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module Utils where import Control.Monad (unless) import System.IO.Error (tryIOError) import System.Directory (createDirectory, doesDirectoryExist, renameFile, removeFile, doesFileExist) infixr 5 +++ infixr 5 ++++ infixr 5 +++++ infixr 2 ||| infixr 5 ... infixr 3 *** -- printing operations a +++ b = a ++ " " ++ b a ++++ b = a ++ "\n" ++ b a +++++ b = a ++ "\n\n" ++ b prParenth s = if s == "" then "" else "(" ++ s ++ ")" -- parser combinators a` la Wadler and Hutton type Parser a b = [a] -> [(b,[a])] (...) :: Parser a b -> Parser a c -> Parser a (b,c) (p ... q) s = [((x,y),r) | (x,t) <- p s, (y,r) <- q t] (|||) :: Parser a b -> Parser a b -> Parser a b (p ||| q) s = p s ++ q s lit :: (Eq a) => a -> Parser a a lit x (c:cs) = [(x,cs) | x == c] lit _ _ = [] (***) :: Parser a b -> (b -> c) -> Parser a c (p *** f) s = [(f x,r) | (x,r) <- p s] succeed :: b -> Parser a b succeed v s = [(v,s)] fails :: Parser a b fails s = [] -- to get parse results parseResults :: Parser a b -> [a] -> [b] parseResults p s = [x | (x,r) <- p s, null r] -- * List utilities -- | Replace all occurences of a value by another value replace :: Eq a => a -- ^ Value to replace -> a -- ^ Value to replace it with -> [a] -> [a] replace x y xs = [ if z == x then y else z | z <- xs] -- | Split a list on the first occurence of a value. -- Does not include the value that was split on in either -- of the returned lists. split :: Eq a => a -> [a] -> ([a],[a]) split x xs = let (ys, zs) = break (==x) xs in (ys, drop 1 zs) -- | Split a list on every occurence of a value. -- If the value does not occur in the list, -- the result is the singleton list containing the input list. -- Thus the returned list is never the empty list. splitAll :: Eq a => a -> [a] -> [[a]] splitAll _ [] = [[]] splitAll x xs = let (ys, zs) = break (==x) xs in ys : case zs of [] -> [] _:zs' -> splitAll x zs' -- * File utilities -- | Ensure that a directory exists. prepareDir :: FilePath -> IO () prepareDir = mapM_ createDirectoryIfNotExists . pathInits -- | Ensure that a directory exists. All parent directories -- must already exist. createDirectoryIfNotExists :: FilePath -> IO () createDirectoryIfNotExists d = do exists <- doesDirectoryExist d unless exists (createDirectory d) pathSep :: Char pathSep = '/' -- | Like the prelude function 'inits' but for path names. -- For example: -- > pathInits "foo/bar" = ["foo","foo/bar"] -- > pathInits "foo/bar/baz.hs" = ["foo","foo/bar","foo/bar/baz.hs"] pathInits :: String -> [String] pathInits "" = [] pathInits xs = let (ys,zs) = split pathSep xs in ys : map ((ys ++ [pathSep]) ++) (pathInits zs) -- | Like basename(1), remove all leading directories from a path name. basename :: String -> String basename = last . splitAll pathSep -- | Write a file, after making a backup of an existing file with the same name. writeFileRep :: FilePath -> String -> IO () writeFileRep = writeFileRep2 -- peteg: FIXME this is racey. -- want to be a bit smarter about whether we actually generate the file -- or save it... e.g. ErrM.hs need not be regenerated if it exists. writeFileRep1 f s = do exists <- doesFileExist f backedUp <- if exists then do let fbak = f ++ ".bak" renameFile f fbak return $ " (saving old file as " ++ fbak ++ ")" else return "" putStrLn $ "writing file " ++ f ++ backedUp writeFile f s -- New version by TH, 2010-09-23 -- If an old version of the file exist and the new version is the same, -- keep the old file and don't create a .bak file. writeFileRep2 :: FilePath -> String -> IO () writeFileRep2 path s = either newFile updateFile =<< tryIOError (readFile path) where newFile _ = do putStrLn $ "writing new file "++path writeFile path s updateFile old = do let tmp=path++".tmp" writeFile tmp s new <- readFile tmp if new==old -- test is O(1) space, O(n) time then do putStrLn $ "no change to file "++path removeFile tmp else do let bak=path++".bak" putStrLn $ "writing file "++path ++" (saving old file as "++bak++")" renameFile path bak renameFile tmp path BNFC-2.6.0.3/src/GetCF.hs0000644000000000000000000003505312100475634012641 0ustar0000000000000000{- BNF Converter: Abstract syntax Copyright (C) 2004 Author: Markus Forsberg, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module GetCF(tryReadCFP) where import Control.Monad ( when ) import CF import Utils import ParBNF import Data.List(nub,partition) import qualified AbsBNF as Abs import Data.Maybe (catMaybes) import Data.Either (partitionEithers) import ErrM import Data.Char import TypeChecker import Options readCF :: SharedOptions -> FilePath -> IO CFP readCF opts f = tryReadCFP opts f >>= return . fst tryReadCFP :: SharedOptions -> FilePath -> IO (CFP,Bool) tryReadCFP opts file = do putStrLn $ "\nReading grammar from " ++ file s <- readFile file let (cfp,msgs1) = getCFP (cnf opts) s cf = cfp2cf cfp msgs2 = case checkDefinitions cf of Bad err -> [err] Ok () -> [] msgs3 = checkTokens cf msg = msgs1++msgs2 -- ++ msgs3 -- in a future version ret = cfp let reserved = if anyTarget opts [TargetJava,TargetJava15] then [takeWhile (/='.') file] else [] case filter (not . isDefinedRule) $ notUniqueNames reserved cf of ns@(_:_) | not (anyTarget opts [TargetHaskell,TargetHaskellGADT,TargetOCAML]) -> do putStrLn $ "ERROR: names not unique: " ++ unwords ns return (ret,False) ns -> do case ns of _:_ -> do putStrLn $ "Warning: names not unique: " ++ unwords ns putStrLn "This can be an error in other back ends." _ -> return () putStrLn $ unlines msgs3 if not (null msg) then do putStrLn $ unlines msg return (ret,False) else do putStrLn $ show (length (rulesOfCF cf)) +++ "rules accepted\n" let c3s = [(b,e) | (b,e) <- fst (comments cf), length b > 2 || length e > 2] if null c3s then return () else do putStrLn "Warning: comment delimiters longer than 2 characters ignored in Haskell:" mapM_ putStrLn [b +++ "-" +++ e | (b,e) <- c3s] return (ret,True) {- case filter (not . isDefinedRule) $ notUniqueFuns cf of [] -> case (badInheritence cf) of [] -> return (ret,True) xs -> do putStrLn "Warning :" putStrLn $ " Bad Label name in Category(s) :" ++ unwords xs putStrLn $ " These categories have more than one Label, yet one of these" putStrLn $ " Labels has the same name as the Category. This will almost" putStrLn $ " certainly cause problems in languages other than Haskell.\n" return (ret,True) xs -> do putStrLn $ "Warning :" putStrLn $ " Non-unique label name(s) : " ++ unwords xs putStrLn $ " There may be problems with the pretty-printer.\n" case (badInheritence cf) of [] -> return (ret,True) xs -> do putStrLn $ "Warning :" putStrLn $ " Bad Label name in Category(s) :" ++ unwords xs putStrLn $ " These categories have more than one Label, yet one of these" putStrLn $ " Labels has the same name as the Category. This will almost" putStrLn $ " certainly cause problems in languages other than Haskell.\n" return (ret,True) -} nilCFP :: CFP nilCFP = CFG (([],([],[],[],[])),[]) getCFP :: Bool -> String -> (CFP,[String]) getCFP cnf s = case pGrammar . myLexer $ s of Bad s -> (nilCFP,[s]) Ok (Abs.Grammar defs) -> (cf0,msgs) where (pragma,rules) = partitionEithers $ concatMap (transDef cnf) defs msgs = catMaybes $ map (checkRule (cfp2cf cf0)) (rulesOfCF cf0) cf0 = revs srt srt = let literals = nub [lit | xs <- map rhsRule rules, Left lit <- xs, elem lit specialCatsP] (symbols,keywords) = partition notIdent reservedWords notIdent s = null s || not (isAlpha (head s)) || any (not . isIdentRest) s isIdentRest c = isAlphaNum c || c == '_' || c == '\'' reservedWords = nub [t | r <- rules, Right t <- rhsRule r] in CFG((pragma,(literals,symbols,keywords,[])),rules) revs cf1@(CFG((pragma,(literals,symbols,keywords,_)),rules)) = CFG((pragma,(literals,symbols,keywords,findAllReversibleCats (cfp2cf cf1))),rules) transDef :: Bool -> Abs.Def -> [Either Pragma RuleP] transDef cnf x = case x of Abs.Rule label cat items -> [Right $ Rule (transLabel label) (transCat cat) (map transItem items)] Abs.Comment str -> [Left $ CommentS str] Abs.Comments str0 str -> [Left $ CommentM (str0,str)] Abs.Token ident reg -> [Left $ TokenReg (transIdent ident) False reg] Abs.PosToken ident reg -> [Left $ TokenReg (transIdent ident) True reg] Abs.Entryp idents -> [Left $ EntryPoints (map transIdent idents)] Abs.Internal label cat items -> [Right $ Rule (transLabel label) (transCat cat) (Left internalCat:(map transItem items))] Abs.Separator size ident str -> map (Right . cf2cfpRule) $ separatorRules size ident str Abs.Terminator size ident str -> map (Right . cf2cfpRule) $ terminatorRules size ident str Abs.Delimiters a b c d e -> map (Right . cf2cfpRule) $ delimiterRules cnf a b c d e Abs.Coercions ident int -> map (Right . cf2cfpRule) $ coercionRules ident int Abs.Rules ident strs -> map (Right . cf2cfpRule) $ ebnfRules ident strs Abs.Layout ss -> [Left $ Layout ss] Abs.LayoutStop ss -> [Left $ LayoutStop ss] Abs.LayoutTop -> [Left $ LayoutTop] Abs.Function f xs e -> [Left $ FunDef (transIdent f) (map transArg xs) (transExp e)] delimiterRules :: Bool -> Abs.Cat -> String -> String -> Abs.Separation -> Abs.MinimumSize -> [Rule] delimiterRules False a0 l r sep size = [ Rule "_" as [Right l, Left (listCat x), Right r] ] ++ separationRules (Abs.IdCat $ Abs.Ident $ x) sep size where a = transCat a0 as = listCat a x = a ++ "_without_delimiters" delimiterRules True a0 l r (Abs.SepTerm "") size = delimiterRules True a0 l r Abs.SepNone size delimiterRules True a0 l r (Abs.SepSepar "") size = delimiterRules True a0 l r Abs.SepNone size delimiterRules True a0 l r sep size = [ -- recognizing a single element Rule "(:[])" a' (Left a : termin), -- optional terminator/separator -- glueing two sublists Rule "(++)" a' [Left a', Left a'], -- starting on either side with a delimiter Rule "[]" c [Right l], Rule (if optFinal then "(:[])" else "[]") d ([Left a | optFinal] ++ [Right r]), -- gathering chains Rule "(++)" c [Left c, Left a'], Rule "(++)" d [Left a', Left d], -- finally, put together left and right chains Rule "(++)" as [Left c,Left d]] ++ [ -- special rule for the empty list if necessary Rule "[]" as [Right l,Right r] | optEmpty] where a = transCat a0 as = listCat a a' = '@':'@':a c = '@':'{':a d = '@':'}':a -- optionally separated concat. of x and y categories. x // y = (Left x : [Right t | Abs.SepSepar t <- [sep]] ++ [Left y ]) termin = case sep of Abs.SepSepar t -> [Right t] Abs.SepTerm t -> [Right t] _ -> [] optFinal = case (sep,size) of (Abs.SepSepar t,_) -> True (Abs.SepTerm _,Abs.MNonempty) -> True (Abs.SepNone,Abs.MNonempty) -> True _ -> False optEmpty = case sep of Abs.SepSepar _ -> size == Abs.MEmpty _ -> False separationRules :: Abs.Cat -> Abs.Separation -> Abs.MinimumSize -> [Rule] separationRules c Abs.SepNone size = terminatorRules size c "" separationRules c (Abs.SepTerm t) size = terminatorRules size c t separationRules c (Abs.SepSepar t) size = separatorRules size c t separatorRules :: Abs.MinimumSize -> Abs.Cat -> String -> [Rule] separatorRules size c s = if null s then terminatorRules size c s else ifEmpty [ Rule "(:[])" cs [Left c'], Rule "(:)" cs [Left c', Right s, Left cs] ] where c' = transCat c cs = listCat c' ifEmpty rs = if (size == Abs.MNonempty) then rs else Rule "[]" cs [] : rs terminatorRules :: Abs.MinimumSize -> Abs.Cat -> String -> [Rule] terminatorRules size c s = [ ifEmpty, Rule "(:)" cs (Left c' : s' [Left cs]) ] where c' = transCat c cs = listCat c' s' its = if null s then its else (Right s : its) ifEmpty = if (size == Abs.MNonempty) then Rule "(:[])" cs ([Left c'] ++ if null s then [] else [Right s]) else Rule "[]" cs [] coercionRules :: Abs.Ident -> Integer -> [Rule] coercionRules (Abs.Ident c) n = Rule "_" c [Left (c ++ "1")] : [(Rule "_" (c ++ show (i-1)) [Left (c ++ show i)]) | i <- [2..n]] ++ [(Rule "_" (c ++ show n) [Right "(", Left c, Right ")"])] ebnfRules :: Abs.Ident -> [Abs.RHS] -> [Rule] ebnfRules (Abs.Ident c) rhss = [Rule (mkFun k c its) c (map transItem its) | (k, Abs.RHS its) <- zip [1 :: Int ..] rhss] where mkFun k c i = case i of [Abs.Terminal s] -> c' ++ "_" ++ mkName k s [Abs.NTerminal n] -> c' ++ identCat (transCat n) _ -> c' ++ "_" ++ show k c' = c --- normCat c mkName k s = if all (\c -> isAlphaNum c || elem c "_'") s then s else show k transItem :: Abs.Item -> Either Cat String transItem x = case x of Abs.Terminal str -> Right str Abs.NTerminal cat -> Left (transCat cat) transCat :: Abs.Cat -> Cat transCat x = case x of Abs.ListCat cat -> "[" ++ (transCat cat) ++ "]" Abs.IdCat id -> transIdent id transLabel :: Abs.Label -> (Fun,Prof) transLabel y = case y of Abs.LabNoP f -> let g = transLabelId f in (g,(g,[])) ---- should be Nothing Abs.LabP f p -> let g = transLabelId f in (g,(g, map transProf p)) Abs.LabPF f g p -> (transLabelId f,(transLabelId g, map transProf p)) Abs.LabF f g -> (transLabelId f,(transLabelId g, [])) where transLabelId x = case x of Abs.Id id -> transIdent id Abs.Wild -> "_" Abs.ListE -> "[]" Abs.ListCons -> "(:)" Abs.ListOne -> "(:[])" transProf (Abs.ProfIt bss as) = ([map fromInteger bs | Abs.Ints bs <- bss], map fromInteger as) transIdent :: Abs.Ident -> String transIdent x = case x of Abs.Ident str -> str transArg :: Abs.Arg -> String transArg (Abs.Arg x) = transIdent x transExp :: Abs.Exp -> Exp transExp e = case e of Abs.App x es -> App (transIdent x) (map transExp es) Abs.Var x -> App (transIdent x) [] Abs.Cons e1 e2 -> cons e1 (transExp e2) Abs.List es -> foldr cons nil es Abs.LitInt x -> LitInt x Abs.LitDouble x -> LitDouble x Abs.LitChar x -> LitChar x Abs.LitString x -> LitString x where cons e1 e2 = App "(:)" [transExp e1, e2] nil = App "[]" [] -------------------------------------------------------------------------------- --checkTokens :: CFG f -> [String] checkTokens cf = if null ns then [] else ["Warning : ", -- change to error in a future version " The following tokens accept the empty string: ", " "++unwords ns, " This is error-prone and will not be supported in the future."] where ns = map fst . filter (nullable.snd) $ tokenPragmas cf -- | Check if a regular expression is nullable (accepts the empty string) nullable :: Abs.Reg -> Bool nullable r = case r of Abs.RSeq r1 r2 -> nullable r1 && nullable r2 Abs.RAlt r1 r2 -> nullable r1 || nullable r2 Abs.RMinus r1 r2 -> nullable r1 && not (nullable r2) Abs.RStar _ -> True Abs.RPlus r1 -> nullable r1 Abs.ROpt _ -> True Abs.REps -> True Abs.RChar _ -> False Abs.RAlts _ -> False Abs.RSeqs s -> null s Abs.RDigit -> False Abs.RLetter -> False Abs.RUpper -> False Abs.RLower -> False Abs.RAny -> False -- we should actually check that -- (1) coercions are always between variants -- (2) no other digits are used checkRule :: CF -> RuleP -> Maybe String checkRule cf (Rule _ ('@':_) rhs) = Nothing -- Generated by a pragma; it's a trusted category checkRule cf (Rule (f,_) cat rhs) | badCoercion = Just $ "Bad coercion in rule" +++ s | badNil = Just $ "Bad empty list rule" +++ s | badOne = Just $ "Bad one-element list rule" +++ s | badCons = Just $ "Bad list construction rule" +++ s | badList = Just $ "Bad list formation rule" +++ s | badSpecial = Just $ "Bad special category rule" +++ s | badTypeName = Just $ "Bad type name" +++ unwords badtypes +++ "in" +++ s | badFunName = Just $ "Bad constructor name" +++ f +++ "in" +++ s | badMissing = Just $ "No production for" +++ unwords missing ++ ", appearing in rule" +++ s | otherwise = Nothing where s = f ++ "." +++ cat +++ "::=" +++ unwords (map (either id show) rhs) -- Todo: consider using the show instance of Rule c = normCat cat cs = [normCat c | Left c <- rhs] badCoercion = isCoercion f && not ([c] == cs) badNil = isNilFun f && not (isList c && null cs) badOne = isOneFun f && not (isList c && cs == [catOfList c]) badCons = isConsFun f && not (isList c && cs == [catOfList c, c]) badList = isList c && not (isCoercion f || isNilCons f) badSpecial = elem c specialCatsP && not (isCoercion f) badMissing = not (null missing) missing = filter nodef [c | Left c <- rhs] nodef t = notElem t defineds defineds = internalCat : tokenNames cf ++ specialCatsP ++ map valCat (rulesOfCF cf) badTypeName = not (null badtypes) badtypes = filter isBadType $ cat : [c | Left c <- rhs] isBadType c = not (isUpper (head c) || isList c || c == internalCat || (head c == '@') ) badFunName = not (all (\c -> isAlphaNum c || c == '_') f {-isUpper (head f)-} || isCoercion f || isNilCons f) BNFC-2.6.0.3/src/MultiView.hs0000644000000000000000000000762612100475634013643 0ustar0000000000000000{- BNF Converter: Abstract syntax Copyright (C) 2004 Author: Markus Forsberg, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module MultiView where import System.Directory ( doesFileExist, renameFile ) import qualified CF as CF import Utils import ParBNF import PrintBNF import Data.List(nub,partition) import AbsBNF -- import LexBNF import ErrM import Data.Char import TypeChecker preprocessMCF :: FilePath -> IO ([FilePath],String) preprocessMCF f = do s <- readFile f gr <- case pLGrammar $ myLexer s of Ok g -> return g Bad s -> error s let name = takeWhile (/='.') f let grs = extract name gr let entryp = entrypoint gr mapM_ writeCF grs return $ (map fst grs,entryp) extract :: String -> LGrammar -> [(FilePath, Grammar)] extract name (LGr ldefs) = [(file lang,Grammar [unldef ldef | ldef <- ldefs, isFor lang ldef]) | lang <- views] where views = [lang | LDefView langs <- ldefs, Ident lang <- langs] isFor lang ldef = case ldef of DefAll _ -> True DefSome ids _ -> elem (Ident lang) ids _ -> False unldef ldef = case ldef of DefAll d -> d DefSome _ d -> d file lang = name ++ "_" ++ lang ++ ".cf" --- the entrypoint is the same for all languages - could be different entrypoint :: LGrammar -> String entrypoint (LGr rs0) = head $ [c | Entryp (Ident c:_) <- rs] ++ [c | Rule _ (IdCat (Ident c)) _ <- rs] where rs = concatMap getR rs0 getR d = case d of DefAll d -> [d] DefSome _ d -> [d] _ -> [] --- LDefView writeCF :: (FilePath, Grammar) -> IO () writeCF (file,gr) = do writeFile file $ printTree gr putStrLn $ "wrote file " ++ file ---- These are Haskell specific; ---- should be generalized by inspecting the options xx mkTestMulti :: String -> [String] -> FilePath -> [FilePath] -> IO () mkTestMulti cat xx file files = do let abs = takeWhile (/='.') file let cncs = map (takeWhile (/='.')) files let content = testfile cat xx abs cncs writeFile ("TestTrans" ++ abs ++ ".hs") content mkMakefileMulti :: [String] -> FilePath -> [FilePath] -> IO () mkMakefileMulti xx file files = do let abs = takeWhile (/='.') file let cncs = map (takeWhile (/='.')) files let content = makefile xx abs cncs writeFile "Makefile" content makefile xx abs cncs = unlines $ "all:" : ["\tmake -f Makefile_" ++ cnc | cnc <- cncs] ++ ["\tghc --make -o TestTrans" ++ abs ++ " TestTrans" ++ abs, "" ] testfile cat xx abs cncs = unlines $ ["module Main where"] ++ ["import qualified Lex" ++ cnc | cnc <- cncs] ++ ["import qualified Par" ++ cnc | cnc <- cncs] ++ ["import qualified Print" ++ cnc | cnc <- cncs] ++ ["import Abs" ++ abs, "import ErrM", "import System.Environment (getArgs)", "", "main :: IO ()", "main = do", " i:o:f:_ <- getArgs", " s <- readFile f", " case parse i s of", " Ok t -> putStrLn $ prin o t", " Bad s -> error s", "", "parse i = case i of" ] ++ [ " " ++ sho cnc ++ " -> Par" ++ cnc ++ ".p" ++ cat ++ " . Par" ++ cnc ++ ".myLexer" | cnc <- cncs ] ++ [ "", "prin o = case o of" ] ++ [ " " ++ sho cnc ++ " -> Print" ++ cnc ++ ".printTree" | cnc <- cncs ] where sho = show . tail . dropWhile (/='_')BNFC-2.6.0.3/src/CF.hs0000644000000000000000000004742212100475634012204 0ustar0000000000000000{-# LANGUAGE PatternGuards, DeriveFunctor, StandaloneDeriving #-} {- BNF Converter: Abstract syntax Copyright (C) 2004 Author: Markus Forberg, Michael Pellauer, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CF ( -- Types. CF, CFG(..), pragmasOfCF, -- ... Rule, Rul(..), lookupRule, Pragma(..), Exp(..), Literal, Symbol, KeyWord, Cat, Fun, Tree(..), prTree, -- print an abstract syntax tree Data, -- describes the abstract syntax of a grammar cf2data, -- translates a grammar to a Data object. cf2dataLists, -- translates to a Data with List categories included. -- Literal categories, constants, firstCat, -- the first value category in the grammar. firstEntry, -- the first entry or the first value category specialCats, -- ident specialCatsP, -- all literals specialData, -- special data isCoercion, -- wildcards in grammar (avoid syntactic clutter) isDefinedRule, -- defined rules (allows syntactic sugar) isProperLabel, -- not coercion or defined rule allCats, -- all categories of a grammar allCatsIdNorm, allEntryPoints, reservedWords, cfTokens, symbols, literals, reversibleCats, findAllReversibleCats, -- find all reversible categories identCat, -- transforms '[C]' to ListC (others, unchanged). isParsable, rulesOfCF, -- All rules of a grammar. rulesForCat, -- rules for a given category ruleGroups, -- Categories are grouped with their rules. ruleGroupsInternals, --As above, but includes internal cats. notUniqueNames, -- list of not unique names (replaces the following 2) -- notUniqueFuns, -- Returns a list of function labels that are not unique. -- badInheritence, -- Returns a list of all function labels that can cause problems in languages with inheritence. isList, -- Checks if a category is a list category. -- Information functions for list functions. isNilFun, -- empty list function? ([]) isOneFun, -- one element list function? (:[]) hasOneFunc, getCons, isConsFun, -- constructor function? (:) isNilCons, -- either three of above? isEmptyListCat, -- checks if the list permits [] revSepListRule, -- reverse a rule, if it is of form C t [C]. normCat, isDataCat, normCatOfList, -- Removes precendence information and enclosed List. C1 => C, C2 => C listCat, catOfList, comments, -- translates the pragmas into two list containing the s./m. comments tokenPragmas, tokenNames, precCat, -- get the precendence level of a Cat C1 => 1, C => 0 precLevels, -- get all precendence levels in the grammar, sorted in increasing order. precRule, -- get the precendence level of the value category of a rule. precCF, -- Check if the CF consists of precendence levels. isUsedCat, internalCat, isPositionCat, hasIdent, hasLayout, layoutPragmas, CFP, -- CF with profiles RuleP, FunP, Prof, cf2cfpRule, cf2cfp, cfp2cf, trivialProf, rulesOfCFP, funRuleP, ruleGroupsP, allCatsP, allEntryPointsP ) where import Utils (prParenth,(+++)) import Data.List (nub, intersperse, partition, sort,sort,group,intercalate) import Data.Char import AbsBNF (Reg()) -- | A context free grammar consists of a set of rules and some extended -- information (e.g. pragmas, literals, symbols, keywords) type CF = CFG Fun -- | A rule consists of a function name, a main category and a sequence of -- terminals and non-terminals. -- function_name . Main_Cat ::= sequence type Rule = Rul Fun -- | Polymorphic rule type for common type signatures for CF and CFP data Rul function = Rule { funRule :: function -- ^ The function (semantic action) of a -- rule. In order to be able to generate -- data types this must be a constructor -- (or an identity function). , valCat :: Cat -- ^ The value category , rhsRule :: [Either Cat String] -- ^ The list of Terminals/NonTerminals in -- the right-hand-side of a rule. } deriving (Eq,Functor) instance (Show function) => Show (Rul function) where show (Rule f cat rhs) = show f ++ ". " ++ cat ++ " ::= " ++ intercalate " " (map (either show id) rhs) -- | Polymorphic CFG type for common type signatures for CF and CFP newtype CFG function = CFG { unCFG :: (Exts,[Rul function]) } deriving (Functor) instance (Show function) => Show (CFG function) where show (CFG (_,rules)) = unlines $ map show rules type Exts = ([Pragma],Info) -- | Info is information extracted from the CF, for easy access. -- Literals - Char, String, Ident, Integer, Double -- Strings are quoted strings, and Ident are unquoted. -- Symbols - symbols in the grammar, e.g. ´*´, '->'. -- KeyWord - reserved words, e.g. 'if' 'while' type Info = ([Literal],[Symbol],[KeyWord],[Cat]) -- Expressions for function definitions data Exp = App String [Exp] | LitInt Integer | LitDouble Double | LitChar Char | LitString String deriving (Eq) instance Show Exp where showsPrec p e = case listView e of Right es -> showString "[" . foldr (.) id (intersperse (showString ", ") $ map shows es) . showString "]" Left (App x []) -> showString x Left (App "(:)" [e1,e2]) -> showParen (p>0) $ showsPrec 1 e1 . showString " : " . shows e2 Left (App x es) -> showParen (p>1) $ foldr (.) id $ intersperse (showString " ") $ showString x : map (showsPrec 2) es Left (LitInt n) -> shows n Left (LitDouble x) -> shows x Left (LitChar c) -> shows c Left (LitString s) -> shows s where listView (App "[]" []) = Right [] listView (App "(:)" [e1,e2]) | Right es <- listView e2 = Right $ e1:es listView e = Left e -- | Pragmas data Pragma = CommentS String -- ^ for single line comments | CommentM (String,String) -- ^ for multiple-line comments. | TokenReg String Bool Reg -- ^ for tokens | EntryPoints [Cat] | Layout [String] | LayoutStop [String] | LayoutTop | FunDef String [String] Exp -- ... deriving (Show) -- | User-defined regular expression tokens tokenPragmas :: CFG f -> [(String,Reg)] tokenPragmas cf = [(name,exp) | TokenReg name _ exp <- pragmasOfCF cf] -- | The names of all user-defined tokens tokenNames :: CFG f -> [String] tokenNames cf = map fst (tokenPragmas cf) layoutPragmas :: CF -> (Bool,[String],[String]) layoutPragmas cf = let ps = pragmasOfCF cf in ( not (null [() | LayoutTop <- ps]), -- if there's layout betw top-level concat [ss | Layout ss <- ps], -- layout-block starting words concat [ss | LayoutStop ss <- ps] -- layout-block ending words ) hasLayout :: CF -> Bool hasLayout cf = case layoutPragmas cf of (t,ws,_) -> t || not (null ws) -- (True,[],_) means: top-level layout only -- | Literal: Char, String, Ident, Integer, Double type Literal = Cat type Symbol = String type KeyWord = String -- | Cat is the Non-terminals of the grammar. type Cat = String -- | Fun is the function name of a rule. type Fun = String -- | Either Cat or Fun type Name = String -- | The category '#'. It is inserted in 1st position in "internal" -- rules, essentially ensuring that they are never parsed. internalCat :: Cat internalCat = "#" -- | Abstract syntax tree. newtype Tree = Tree (Fun,[Tree]) -- | The abstract syntax of a grammar. type Data = (Cat, [(Fun,[Cat])]) -- | firstCat returns the first Category appearing in the grammar. firstCat :: CF -> Cat firstCat = valCat . head . rulesOfCF firstEntry :: CF -> Cat firstEntry cf = case allEntryPoints cf of (x:_) -> x _ -> firstCat cf rulesOfCF :: CFG f -> [Rul f] rulesOfCFP :: CFP -> [RuleP] infoOfCF :: CFG f -> Info pragmasOfCF :: CFG f -> [Pragma] rulesOfCF = snd . unCFG rulesOfCFP = rulesOfCF infoOfCF = snd . fst . unCFG pragmasOfCF = fst . fst . unCFG -- aggressively ban nonunique names (AR 31/5/2012) notUniqueNames :: [Name] -> CF -> [Fun] notUniqueNames reserved cf = [head xs | xs <- xss, length xs > 1] where xss = group (sort names) names = reserved ++ allCatsIdNorm cf ++ allFuns cf allFuns g = [ f | f <- map funRule (rulesOfCF g), not (isNilCons f || isCoercion f)] {-# DEPRECATED notUniqueFuns "obsolete" #-} notUniqueFuns :: CF -> [Fun] notUniqueFuns cf = let xss = group $ sort [ f | f <- map funRule (rulesOfCF cf), not (isNilCons f || isCoercion f)] in [ head xs | xs <- xss, length xs > 1] badInheritence :: CF -> [Cat] badInheritence cf = concatMap checkGroup (ruleGroups cf) where checkGroup (cat, rs) = if (length rs <= 1) then [] else case lookupRule cat rs of Nothing -> [] Just x -> [cat] -- extract the comment pragmas. commentPragmas :: [Pragma] -> [Pragma] commentPragmas = filter isComment where isComment (CommentS _) = True isComment (CommentM _) = True isComment _ = False lookupRule :: Eq f => f -> [Rul f] -> Maybe (Cat, [Either Cat String]) lookupRule f = lookup f . map unRule where unRule (Rule f c rhs) = (f,(c,rhs)) -- | Returns all normal rules that constructs the given Cat. rulesForCat :: CF -> Cat -> [Rule] rulesForCat cf cat = [normRuleFun r | r <- rulesOfCF cf, isParsable r, valCat r == cat] -- | As rulesForCat, but this version doesn't exclude internal rules. rulesForCat' :: CF -> Cat -> [Rule] rulesForCat' cf cat = [normRuleFun r | r <- rulesOfCF cf, valCat r == cat] -- | Get all categories of a grammar. (No Cat w/o production returned; No duplicates) allCats :: CFG f -> [Cat] allCats = nub . map valCat . rulesOfCF -- | Gets all normalized identified Categories allCatsIdNorm :: CF -> [Cat] allCatsIdNorm = nub . map identCat . map normCat . allCats -- | Is the category is used on an rhs? isUsedCat :: CFG f -> Cat -> Bool isUsedCat cf cat = elem cat [c | r <- (rulesOfCF cf), Left c <- rhsRule r] -- | Group all categories with their rules. ruleGroups :: CF -> [(Cat,[Rule])] ruleGroups cf = [(c, rulesForCat cf c) | c <- allCats cf] -- | Group all categories with their rules including internal rules. ruleGroupsInternals :: CF -> [(Cat,[Rule])] ruleGroupsInternals cf = [(c, rulesForCat' cf c) | c <- allCats cf] -- | Get all literals of a grammar. (e.g. String, Double) literals :: CFG f -> [String] literals cf = lits ++ owns where (lits,_,_,_) = infoOfCF cf owns = tokenNames cf {-# DEPRECATED symbols, reservedWords "Almost certainly, you should treat symbols and reserved words uniformly, so use cfTokens instead." #-} -- | Get all symbols symbols :: CFG f -> [String] symbols cf = syms where (_,syms,_,_) = infoOfCF cf -- | Get the keywords of a grammar. reservedWords :: CFG f -> [String] reservedWords cf = sort keywords where (_,_,keywords,_) = infoOfCF cf -- | Canonical, numbered list of symbols and reserved words. (These do -- not end up in the AST.) cfTokens :: CFG f -> [(String,Int)] cfTokens cf = zip (sort (symbols cf ++ reservedWords cf)) [1..] -- NOTE: some backends (incl. Haskell) assume that this list is sorted. -- | Categories that is left-recursive transformable. reversibleCats :: CFG f -> [Cat] reversibleCats cf = cats where (_,_,_,cats) = infoOfCF cf -- | Comments can be defined by the 'comment' pragma comments :: CF -> ([(String,String)],[String]) comments cf = case commentPragmas (pragmasOfCF cf) of xs -> ([p | CommentM p <- xs], [s | CommentS s <- xs]) -- built-in categories (corresponds to lexer) -- | Whether the grammar uses the predefined Ident type. hasIdent :: CFG f -> Bool hasIdent cf = isUsedCat cf "Ident" -- these need new datatypes -- | Categories corresponding to tokens. These end up in the -- AST. (unlike tokens returned by 'cfTokens') specialCats :: CF -> [Cat] specialCats cf = (if hasIdent cf then ("Ident":) else id) (tokenNames cf) -- the parser needs these specialCatsP :: [Cat] specialCatsP = words "Ident Integer String Char Double" -- to print parse trees prTree :: Tree -> String prTree (Tree (fun,[])) = fun prTree (Tree (fun,trees)) = fun +++ unwords (map pr2 trees) where pr2 t@(Tree (_,ts)) = (if (null ts) then id else prParenth) (prTree t) -- abstract syntax trees: data type definitions cf2data' :: (Cat -> Bool) -> CF -> [Data] cf2data' predicate cf = [(cat, nub (map mkData [r | r <- rulesOfCF cf, let f = funRule r, not (isDefinedRule f), not (isCoercion f), eqCat cat (valCat r)])) | cat <- filter predicate (allCats cf)] where mkData (Rule f _ its) = (normFun f,[normCat c | Left c <- its, c /= internalCat]) cf2data :: CF -> [Data] cf2data = cf2data' isDataCat -- | Does the category correspond to a data type? isDataCat c = isDataOrListCat c && not (isList c) isDataOrListCat c = not (isDigit (last c) || head c == '@') cf2dataLists :: CF -> [Data] cf2dataLists = cf2data' isDataOrListCat specialData :: CF -> [Data] specialData cf = [(c,[(c,[arg c])]) | c <- specialCats cf] where arg c = case c of _ -> "String" -- to deal with coercions -- the Haskell convention: the wildcard _ is not a constructor -- | Is this function just a coercion? (Ie. the identity) isCoercion :: Fun -> Bool isCoercion = (== "_") -- perhaps this should be changed to "id"? isDefinedRule :: Fun -> Bool isDefinedRule (x:_) = isLower x isProperLabel :: Fun -> Bool isProperLabel f = not (isCoercion f || isDefinedRule f) -- categories C1, C2,... (one digit in end) are variants of C eqCat :: Cat -> Cat -> Bool eqCat c c1 = catCat c == catCat c1 where catCat :: Cat -> Cat catCat = fst . analyseCat -- | Removes precendence information. C1 => C, [C2] => [C] normCat :: Cat -> Cat normCat c = case c of '[':cs -> "[" ++ norm (init cs) ++ "]" _ -> unList $ norm c -- to be deprecated where norm = reverse . dropWhile isDigit . reverse normCatOfList :: Cat -> Cat normCatOfList = normCat . catOfList -- | When given a list Cat, i.e. '[C]', it removes the square -- brackets, and adds the prefix List, i.e. 'ListC'. (for Happy and -- Latex) identCat :: Cat -> Cat identCat c = case c of '[':cs -> "List" ++ identCat (init cs) _ -> c {-# DEPRECATED normFun "It's just the identity function" #-} normFun :: Fun -> Fun normFun = id -- takeWhile (not . isDigit) normRuleFun :: Rule -> Rule normRuleFun (Rule f p rhs) = Rule (normFun f) p rhs -- | Checks if the rule is parsable. isParsable :: Rul f -> Bool isParsable (Rule _ _ (Left c:_)) = c /= internalCat isParsable _ = True isList :: Cat -> Bool isList c = head c == '[' {-# DEPRECATED unList "It's just the identity function" #-} unList :: Cat -> Cat unList c = c -- | Adds list constructor listCat :: Cat -> Cat listCat c = "[" ++ c ++ "]" -- | Unwraps the list constructor from the category name. Eg. [C1] => C1 catOfList :: Cat -> Cat catOfList c = case c of '[':_:_ -> init (tail c) _ -> c isNilFun, isOneFun, isConsFun, isNilCons,isConcatFun :: Fun -> Bool isNilCons f = isNilFun f || isOneFun f || isConsFun f || isConcatFun f isNilFun f = f == "[]" isOneFun f = f == "(:[])" isConsFun f = f == "(:)" isConcatFun f = f == "(++)" -- | Checks if the list has a non-empty rule. hasOneFunc :: [Rule] -> Bool hasOneFunc = any (isOneFun . funRule) -- | Gets the separator for a list. getCons :: [Rule] -> String getCons (Rule f c cats:rs) = if isConsFun f then seper cats else getCons rs where seper [] = [] seper ((Right x):xs) = x seper ((Left x):xs) = seper xs isEmptyListCat :: CF -> Cat -> Bool isEmptyListCat cf c = elem "[]" $ map funRule $ rulesForCat' cf c isNonterm = either (const True) (const False) -- used in Happy to parse lists of form 'C t [C]' in reverse order -- applies only if the [] rule has no terminals revSepListRule :: Rul f -> Rul f revSepListRule (Rule f c ts) = Rule f c (xs : x : sep) where (x,sep,xs) = (head ts, init (tail ts), last ts) -- invariant: test in findAllReversibleCats have been performed findAllReversibleCats :: CF -> [Cat] findAllReversibleCats cf = [c | (c,r) <- ruleGroups cf, isRev c r] where isRev c rs = case rs of [r1,r2] | isList c -> if isConsFun (funRule r2) then tryRev r2 r1 else if isConsFun (funRule r1) then tryRev r1 r2 else False _ -> False tryRev (Rule f _ ts@(x:_:xs)) r = isEmptyNilRule r && isConsFun f && isNonterm x && isNonterm (last ts) tryRev _ _ = False isEmptyNilRule (Rule f _ ts) = isNilFun f && null ts precCat :: Cat -> Int precCat = snd . analyseCat precRule :: Rule -> Int precRule = precCat . valCat precLevels :: CF -> [Int] precLevels cf = sort $ nub $ [ precCat c | c <- allCats cf] precCF :: CF -> Bool precCF cf = length (precLevels cf) > 1 analyseCat :: Cat -> (Cat,Int) analyseCat c = if (isList c) then list c else noList c where list cat = let (rc,n) = noList (init (tail cat)) in (listCat rc,n) noList cat = case span isDigit (reverse cat) of ([],c') -> (reverse c', 0) (d,c') -> (reverse c', read (reverse d)) -- | Does the category have a position stored in AST? isPositionCat :: CFG f -> Cat -> Bool isPositionCat cf cat = or [b | TokenReg name b _ <- pragmasOfCF cf, name == cat] -- | Grammar with permutation profile à la GF. AR 22/9/2004 type CFP = CFG FunP -- (Exts,[RuleP]) type FunP = (Fun,Prof) type RuleP = Rul FunP -- (FunP, (Cat, [Either Cat String])) -- | Pair of: the original function name, profile type Prof = (Fun, [([[Int]],[Int])]) cf2cfp :: CF -> CFP cf2cfp (CFG (es,rs)) = CFG (es, map cf2cfpRule rs) cf2cfpRule :: Rule -> RuleP cf2cfpRule (Rule f c its) = Rule (f, (f, trivialProf its)) c its cfp2cf :: CFP -> CF cfp2cf = fmap fst trivialProf :: [Either Cat String] -> [([[Int]],[Int])] trivialProf its = [([],[i]) | (i,_) <- zip [0..] [c | Left c <- its]] {-# DEPRECATED rulesOfCFP, allCatsP, allEntryPointsP "Use the version without P postfix instead" #-} funRuleP :: RuleP -> Fun funRuleP = fst . funRule ruleGroupsP :: CFP -> [(Cat,[RuleP])] ruleGroupsP cf = [(c, rulesForCatP cf c) | c <- allCatsP cf] rulesForCatP :: CFP -> Cat -> [RuleP] rulesForCatP cf cat = [r | r <- rulesOfCFP cf, isParsable r, valCat r == cat] allCatsP :: CFP -> [Cat] allCatsP = allCats -- | Categories that are entry points to the parser allEntryPoints :: CFG f -> [Cat] allEntryPoints cf = case concat [cats | EntryPoints cats <- pragmasOfCF cf] of [] -> allCats cf cs -> cs allEntryPointsP :: CFP -> [Cat] allEntryPointsP = allEntryPointsBNFC-2.6.0.3/src/TypeChecker.hs0000644000000000000000000001122512100475634014112 0ustar0000000000000000 module TypeChecker where import Control.Monad import Data.List import Data.Char import CF import ErrM data Base = BaseT String | ListT Base deriving (Eq) data Type = FunT [Base] Base deriving (Eq) instance Show Base where show (BaseT x) = x show (ListT t) = "[" ++ show t ++ "]" instance Show Type where show (FunT ts t) = unwords $ map show ts ++ ["->", show t] data Context = Ctx { ctxLabels :: [(String, Type)] , ctxTokens :: [String] } catchErr :: Err a -> (String -> Err a) -> Err a catchErr (Bad s) f = f s catchErr (Ok x) _ = Ok x buildContext :: CF -> Context buildContext cf@(CFG(_,rules)) = Ctx [ (f, mkType cat args) | Rule f cat args <- rules , not (isCoercion f) , not (isNilCons f) ] ("Ident" : tokenNames cf) where mkType cat args = FunT [ mkBase t | Left t <- args, t /= internalCat ] (mkBase cat) mkBase t | isList t = ListT $ mkBase $ normCatOfList t | otherwise = BaseT $ normCat t isToken :: String -> Context -> Bool isToken x ctx = elem x $ ctxTokens ctx extendContext :: Context -> [(String,Type)] -> Context extendContext ctx xs = ctx { ctxLabels = xs ++ ctxLabels ctx } lookupCtx :: String -> Context -> Err Type lookupCtx x ctx | isToken x ctx = return $ FunT [BaseT "String"] (BaseT x) | otherwise = case lookup x $ ctxLabels ctx of Nothing -> fail $ "Undefined symbol '" ++ x ++ "'." Just t -> return t checkDefinitions :: CF -> Err () checkDefinitions cf = do checkContext ctx sequence_ [checkDefinition ctx f xs e | FunDef f xs e <- pragmasOfCF cf] where ctx = buildContext cf checkContext :: Context -> Err () checkContext ctx = mapM_ checkEntry $ groupSnd $ ctxLabels ctx where -- This is a very handy function which transforms a lookup table -- with duplicate keys to a list valued lookup table with no duplicate -- keys. groupSnd :: Ord a => [(a,b)] -> [(a,[b])] groupSnd = map ((fst . head) /\ map snd) . groupBy ((==) **.* fst) . sortBy (compare **.* fst) (f /\ g) x = (f x, g x) (f **.* g) x y = f (g x) (g y) checkEntry (f,ts) = case nub ts of [_] -> return () ts' -> fail $ "The symbol '" ++ f ++ "' is used at conflicting types:\n" ++ unlines (map ((" " ++) . show) ts') checkDefinition :: Context -> String -> [String] -> Exp -> Err () checkDefinition ctx f xs e = do checkDefinition' dummyConstructors ctx f xs e return () data ListConstructors = LC { nil :: Base -> String , cons :: Base -> String } dummyConstructors :: ListConstructors dummyConstructors = LC (const "[]") (const "(:)") checkDefinition' :: ListConstructors -> Context -> String -> [String] -> Exp -> Err ([(String,Base)],(Exp,Base)) checkDefinition' list ctx f xs e = do unless (isLower $ head f) $ fail "Defined functions must start with a lowercase letter." t@(FunT ts t') <- lookupCtx f ctx `catchErr` \_ -> fail $ "'" ++ f ++ "' must be used in a rule." let expect = length ts given = length xs unless (expect == given) $ fail $ "'" ++ f ++ "' is used with type " ++ show t ++ " but defined with " ++ show given ++ " argument" ++ plural given ++ "." e' <- checkExp list (extendContext ctx $ zip xs (map (FunT []) ts)) e t' return (zip xs ts, (e', t')) `catchErr` \err -> fail $ "In the definition " ++ unwords (f : xs ++ ["=",show e,";"]) ++ "\n " ++ err where plural 1 = "" plural _ = "s" checkExp :: ListConstructors -> Context -> Exp -> Base -> Err Exp checkExp list ctx (App "[]" []) (ListT t) = return (App (nil list t) []) checkExp _ _ (App "[]" _) _ = fail $ "[] is applied to too many arguments." checkExp list ctx (App "(:)" [e,es]) (ListT t) = do e' <- checkExp list ctx e t es' <- checkExp list ctx es (ListT t) return $ App (cons list t) [e',es'] checkExp _ _ (App "(:)" es) _ = fail $ "(:) takes 2 arguments, but has been given " ++ show (length es) ++ "." checkExp list ctx e@(App x es) t = do FunT ts t' <- lookupCtx x ctx es' <- matchArgs ctx es ts unless (t == t') $ fail $ show e ++ " has type " ++ show t' ++ ", but something of type " ++ show t ++ " was expected." return $ App x es' where matchArgs ctx es ts | expect /= given = fail $ "'" ++ x ++ "' takes " ++ show expect ++ " arguments, but has been given " ++ show given ++ "." | otherwise = zipWithM (checkExp list ctx) es ts where expect = length ts given = length es checkExp _ _ e@(LitInt _) (BaseT "Integer") = return e checkExp _ _ e@(LitDouble _) (BaseT "Double") = return e checkExp _ _ e@(LitChar _) (BaseT "Char") = return e checkExp _ _ e@(LitString _) (BaseT "String") = return e checkExp _ _ e t = fail $ show e ++ " does not have type " ++ show t ++ "." BNFC-2.6.0.3/src/ErrM.hs0000644000000000000000000000107712100475634012555 0ustar0000000000000000-- BNF Converter: Error Monad -- Copyright (C) 2004 Author: Aarne Ranta -- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE. module ErrM where -- the Error monad: like Maybe type with error msgs import Control.Monad (MonadPlus(..), liftM) data Err a = Ok a | Bad String deriving (Read, Show, Eq, Ord) instance Monad Err where return = Ok fail = Bad Ok a >>= f = f a Bad s >>= f = Bad s instance Functor Err where fmap = liftM instance MonadPlus Err where mzero = Bad "Err.mzero" mplus (Bad _) y = y mplus x _ = x BNFC-2.6.0.3/src/BNF.cf0000644000000000000000000001024412100475635012270 0ustar0000000000000000{- BNF Converter: Language definition Copyright (C) 2004 Author: Markus Forberg, Michael Pellauer, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- A Grammar is a sequence of definitions LGr. LGrammar ::= [LDef] ; DefAll. LDef ::= Def ; DefSome. LDef ::= [Ident] ":" Def ; LDefView. LDef ::= "views" [Ident] ; separator LDef ";" ; Grammar . Grammar ::= [Def] ; separator Def ";" ; [] . [Item] ::= ; (:) . [Item] ::= Item [Item] ; --The rules of the grammar Rule . Def ::= Label "." Cat "::=" [Item] ; -- Items Terminal . Item ::= String ; NTerminal . Item ::= Cat ; -- Categories ListCat . Cat ::= "[" Cat "]" ; IdCat . Cat ::= Ident ; -- labels with or without profiles LabNoP . Label ::= LabelId ; LabP . Label ::= LabelId [ProfItem] ; LabPF . Label ::= LabelId LabelId [ProfItem] ; LabF . Label ::= LabelId LabelId ; -- functional labels Id . LabelId ::= Ident ; Wild . LabelId ::= "_" ; ListE . LabelId ::= "[" "]" ; ListCons . LabelId ::= "(" ":" ")" ; ListOne . LabelId ::= "(" ":" "[" "]" ")" ; -- profiles (= permutation and binding patterns) ProfIt . ProfItem ::= "(" "[" [IntList] "]" "," "[" [Integer] "]" ")" ; Ints . IntList ::= "[" [Integer] "]" ; separator Integer "," ; separator IntList "," ; terminator nonempty ProfItem "" ; -- Pragmas Comment . Def ::= "comment" String ; Comments . Def ::= "comment" String String ; Internal . Def ::= "internal" Label "." Cat "::=" [Item] ; Token. Def ::= "token" Ident Reg ; PosToken. Def ::= "position" "token" Ident Reg ; Entryp. Def ::= "entrypoints" [Ident] ; Separator. Def ::= "separator" MinimumSize Cat String ; Terminator. Def ::= "terminator" MinimumSize Cat String ; Delimiters. Def ::= "delimiters" Cat String String Separation MinimumSize; Coercions. Def ::= "coercions" Ident Integer ; Rules. Def ::= "rules" Ident "::=" [RHS] ; Function. Def ::= "define" Ident [Arg] "=" Exp ; SepNone. Separation ::= ; SepTerm. Separation ::= "terminator" String; SepSepar. Separation ::= "separator" String; Layout. Def ::= "layout" [String] ; LayoutStop. Def ::= "layout" "stop" [String] ; LayoutTop. Def ::= "layout" "toplevel" ; Arg. Arg ::= Ident ; separator Arg "" ; -- Expressions Cons. Exp ::= Exp1 ":" Exp ; App. Exp1 ::= Ident [Exp2] ; Var. Exp2 ::= Ident ; LitInt. Exp2 ::= Integer ; LitChar. Exp2 ::= Char ; LitString. Exp2 ::= String ; LitDouble. Exp2 ::= Double ; List. Exp2 ::= "[" [Exp] "]" ; coercions Exp 2; separator nonempty Exp2 "" ; separator Exp "," ; separator nonempty String "," ; separator nonempty RHS "|" ; RHS. RHS ::= [Item] ; -- List size condition MNonempty. MinimumSize ::= "nonempty" ; MEmpty. MinimumSize ::= ; -- regular expressions RSeq. Reg2 ::= Reg2 Reg3 ; RAlt. Reg1 ::= Reg1 "|" Reg2 ; RMinus. Reg1 ::= Reg2 "-" Reg2 ; RStar. Reg3 ::= Reg3 "*" ; RPlus. Reg3 ::= Reg3 "+" ; ROpt. Reg3 ::= Reg3 "?" ; REps. Reg3 ::= "eps" ; RChar. Reg3 ::= Char ; -- single character RAlts. Reg3 ::= "[" String "]" ; -- list of alternative characters RSeqs. Reg3 ::= "{" String "}" ; -- character sequence RDigit. Reg3 ::= "digit" ; RLetter. Reg3 ::= "letter" ; RUpper. Reg3 ::= "upper" ; RLower. Reg3 ::= "lower" ; RAny. Reg3 ::= "char" ; _. Reg ::= Reg1 ; _. Reg1 ::= Reg2 ; _. Reg2 ::= Reg3 ; _. Reg3 ::= "(" Reg ")" ; -- list of categories in the entrypoint pragma (:[]). [Ident] ::= Ident ; (:). [Ident] ::= Ident "," [Ident] ; -- comments in BNF source comment "--" ; comment "{-" "-}" ; BNFC-2.6.0.3/src/LexBNF.x0000644000000000000000000001334612100475634012625 0ustar0000000000000000-- -*- haskell -*- -- This Alex file was machine-generated by the BNF converter { {-# OPTIONS -fno-warn-incomplete-patterns #-} module LexBNF where import qualified Data.Bits import Data.Word (Word8) } $l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME $c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME $s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME $d = [0-9] -- digit $i = [$l $d _ '] -- identifier character $u = [\0-\255] -- universal: any character @rsyms = -- symbols and non-identifier-like reserved words \: | \; | \. | \: \: \= | \[ | \] | \_ | \( | \) | \, | \= | \| | \- | \* | \+ | \? | \{ | \} :- "--" [.]* ; -- Toss single line comments "{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; $white+ ; @rsyms { tok (\p s -> PT p (eitherResIdent (TV . share) s)) } $l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) } \" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) } \' ($u # [\' \\] | \\ [\\ \' n t]) \' { tok (\p s -> PT p (TC $ share s)) } $d+ { tok (\p s -> PT p (TI $ share s)) } $d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) } { tok f p s = f p s share :: String -> String share = id data Tok = TS !String !Int -- reserved words and symbols | TL !String -- string literals | TI !String -- integer literals | TV !String -- identifiers | TD !String -- double precision float literals | TC !String -- character literals deriving (Eq,Show,Ord) data Token = PT Posn Tok | Err Posn deriving (Eq,Show,Ord) tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l tokenPos (Err (Pn _ l _) :_) = "line " ++ show l tokenPos _ = "end of file" tokenPosn (PT p _) = p tokenPosn (Err p) = p tokenLineCol = posLineCol . tokenPosn posLineCol (Pn _ l c) = (l,c) mkPosToken t@(PT p _) = (posLineCol p, prToken t) prToken t = case t of PT _ (TS s _) -> s PT _ (TL s) -> s PT _ (TI s) -> s PT _ (TV s) -> s PT _ (TD s) -> s PT _ (TC s) -> s data BTree = N | B String Tok BTree BTree deriving (Show) eitherResIdent :: (String -> Tok) -> String -> Tok eitherResIdent tv s = treeFind resWords where treeFind N = tv s treeFind (B a t left right) | s < a = treeFind left | s > a = treeFind right | s == a = t resWords = b "digit" 21 (b "=" 11 (b "-" 6 (b "*" 3 (b ")" 2 (b "(" 1 N N) N) (b "," 5 (b "+" 4 N N) N)) (b "::=" 9 (b ":" 8 (b "." 7 N N) N) (b ";" 10 N N))) (b "char" 16 (b "]" 14 (b "[" 13 (b "?" 12 N N) N) (b "_" 15 N N)) (b "define" 19 (b "comment" 18 (b "coercions" 17 N N) N) (b "delimiters" 20 N N)))) (b "separator" 31 (b "letter" 26 (b "internal" 24 (b "eps" 23 (b "entrypoints" 22 N N) N) (b "layout" 25 N N)) (b "position" 29 (b "nonempty" 28 (b "lower" 27 N N) N) (b "rules" 30 N N))) (b "upper" 36 (b "token" 34 (b "terminator" 33 (b "stop" 32 N N) N) (b "toplevel" 35 N N)) (b "|" 39 (b "{" 38 (b "views" 37 N N) N) (b "}" 40 N N)))) where b s n = let bs = id s in B bs (TS bs n) unescapeInitTail :: String -> String unescapeInitTail = id . unesc . tail . id where unesc s = case s of '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs '\\':'n':cs -> '\n' : unesc cs '\\':'t':cs -> '\t' : unesc cs '"':[] -> [] c:cs -> c : unesc cs _ -> [] ------------------------------------------------------------------- -- Alex wrapper code. -- A modified "posn" wrapper. ------------------------------------------------------------------- data Posn = Pn !Int !Int !Int deriving (Eq, Show,Ord) alexStartPos :: Posn alexStartPos = Pn 0 1 1 alexMove :: Posn -> Char -> Posn alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 alexMove (Pn a l c) _ = Pn (a+1) l (c+1) type Byte = Word8 type AlexInput = (Posn, -- current position, Char, -- previous char [Byte], -- pending bytes on the current char String) -- current input string tokens :: String -> [Token] tokens str = go (alexStartPos, '\n', [], str) where go :: AlexInput -> [Token] go inp@(pos, _, _, str) = case alexScan inp 0 of AlexEOF -> [] AlexError (pos, _, _, _) -> [Err pos] AlexSkip inp' len -> go inp' AlexToken inp' len act -> act pos (take len str) : (go inp') alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s)) alexGetByte (p, _, [], s) = case s of [] -> Nothing (c:s) -> let p' = alexMove p c (b:bs) = utf8Encode c in p' `seq` Just (b, (p', c, bs, s)) alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (p, c, bs, s) = c -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. utf8Encode :: Char -> [Word8] utf8Encode = map fromIntegral . go . ord where go oc | oc <= 0x7f = [oc] | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6) , 0x80 + oc Data.Bits..&. 0x3f ] | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12) , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) , 0x80 + oc Data.Bits..&. 0x3f ] | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18) , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f) , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) , 0x80 + oc Data.Bits..&. 0x3f ] } BNFC-2.6.0.3/src/PrintBNF.hs0000644000000000000000000002320612100475634013330 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} module PrintBNF where -- pretty-printer generated by the BNF converter import AbsBNF import Data.Char -- the top-level printing method printTree :: Print a => a -> String printTree = render . prt 0 type Doc = [ShowS] -> [ShowS] doc :: ShowS -> Doc doc = (:) render :: Doc -> String render d = rend 0 (map ($ "") $ d []) "" where rend i ss = case ss of "[" :ts -> showChar '[' . rend i ts "(" :ts -> showChar '(' . rend i ts "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts ";" :ts -> showChar ';' . new i . rend i ts t : "," :ts -> showString t . space "," . rend i ts t : ")" :ts -> showString t . showChar ')' . rend i ts t : "]" :ts -> showString t . showChar ']' . rend i ts t :ts -> space t . rend i ts _ -> id new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace space t = showString t . (\s -> if null s then "" else (' ':s)) parenth :: Doc -> Doc parenth ss = doc (showChar '(') . ss . doc (showChar ')') concatS :: [ShowS] -> ShowS concatS = foldr (.) id concatD :: [Doc] -> Doc concatD = foldr (.) id replicateS :: Int -> ShowS -> ShowS replicateS n f = concatS (replicate n f) -- the printer class does the job class Print a where prt :: Int -> a -> Doc prtList :: [a] -> Doc prtList = concatD . map (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'') prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"') mkEsc :: Char -> Char -> ShowS mkEsc q s = case s of _ | s == q -> showChar '\\' . showChar s '\\'-> showString "\\\\" '\n' -> showString "\\n" '\t' -> showString "\\t" _ -> showChar s prPrec :: Int -> Int -> Doc -> Doc prPrec i j = if j (concatD []) [x] -> (concatD [prt 0 x]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) instance Print Double where prt _ x = doc (shows x) instance Print Ident where prt _ (Ident i) = doc (showString ( i)) prtList es = case es of [x] -> (concatD [prt 0 x]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) instance Print LGrammar where prt i e = case e of LGr ldefs -> prPrec i 0 (concatD [prt 0 ldefs]) instance Print LDef where prt i e = case e of DefAll def -> prPrec i 0 (concatD [prt 0 def]) DefSome ids def -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 def]) LDefView ids -> prPrec i 0 (concatD [doc (showString "views") , prt 0 ids]) prtList es = case es of [] -> (concatD []) [x] -> (concatD [prt 0 x]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) instance Print Grammar where prt i e = case e of Grammar defs -> prPrec i 0 (concatD [prt 0 defs]) instance Print Def where prt i e = case e of Rule label cat items -> prPrec i 0 (concatD [prt 0 label , doc (showString ".") , prt 0 cat , doc (showString "::=") , prt 0 items]) Comment str -> prPrec i 0 (concatD [doc (showString "comment") , prt 0 str]) Comments str0 str -> prPrec i 0 (concatD [doc (showString "comment") , prt 0 str0 , prt 0 str]) Internal label cat items -> prPrec i 0 (concatD [doc (showString "internal") , prt 0 label , doc (showString ".") , prt 0 cat , doc (showString "::=") , prt 0 items]) Token id reg -> prPrec i 0 (concatD [doc (showString "token") , prt 0 id , prt 0 reg]) PosToken id reg -> prPrec i 0 (concatD [doc (showString "position") , doc (showString "token") , prt 0 id , prt 0 reg]) Entryp ids -> prPrec i 0 (concatD [doc (showString "entrypoints") , prt 0 ids]) Separator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "separator") , prt 0 minimumsize , prt 0 cat , prt 0 str]) Terminator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "terminator") , prt 0 minimumsize , prt 0 cat , prt 0 str]) Delimiters cat str0 str separation minimumsize -> prPrec i 0 (concatD [doc (showString "delimiters") , prt 0 cat , prt 0 str0 , prt 0 str , prt 0 separation , prt 0 minimumsize]) Coercions id n -> prPrec i 0 (concatD [doc (showString "coercions") , prt 0 id , prt 0 n]) Rules id rhss -> prPrec i 0 (concatD [doc (showString "rules") , prt 0 id , doc (showString "::=") , prt 0 rhss]) Function id args exp -> prPrec i 0 (concatD [doc (showString "define") , prt 0 id , prt 0 args , doc (showString "=") , prt 0 exp]) Layout strs -> prPrec i 0 (concatD [doc (showString "layout") , prt 0 strs]) LayoutStop strs -> prPrec i 0 (concatD [doc (showString "layout") , doc (showString "stop") , prt 0 strs]) LayoutTop -> prPrec i 0 (concatD [doc (showString "layout") , doc (showString "toplevel")]) prtList es = case es of [] -> (concatD []) [x] -> (concatD [prt 0 x]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) instance Print Item where prt i e = case e of Terminal str -> prPrec i 0 (concatD [prt 0 str]) NTerminal cat -> prPrec i 0 (concatD [prt 0 cat]) prtList es = case es of [] -> (concatD []) x:xs -> (concatD [prt 0 x , prt 0 xs]) instance Print Cat where prt i e = case e of ListCat cat -> prPrec i 0 (concatD [doc (showString "[") , prt 0 cat , doc (showString "]")]) IdCat id -> prPrec i 0 (concatD [prt 0 id]) instance Print Label where prt i e = case e of LabNoP labelid -> prPrec i 0 (concatD [prt 0 labelid]) LabP labelid profitems -> prPrec i 0 (concatD [prt 0 labelid , prt 0 profitems]) LabPF labelid0 labelid profitems -> prPrec i 0 (concatD [prt 0 labelid0 , prt 0 labelid , prt 0 profitems]) LabF labelid0 labelid -> prPrec i 0 (concatD [prt 0 labelid0 , prt 0 labelid]) instance Print LabelId where prt i e = case e of Id id -> prPrec i 0 (concatD [prt 0 id]) Wild -> prPrec i 0 (concatD [doc (showString "_")]) ListE -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "]")]) ListCons -> prPrec i 0 (concatD [doc (showString "(") , doc (showString ":") , doc (showString ")")]) ListOne -> prPrec i 0 (concatD [doc (showString "(") , doc (showString ":") , doc (showString "[") , doc (showString "]") , doc (showString ")")]) instance Print ProfItem where prt i e = case e of ProfIt intlists ns -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "[") , prt 0 intlists , doc (showString "]") , doc (showString ",") , doc (showString "[") , prt 0 ns , doc (showString "]") , doc (showString ")")]) prtList es = case es of [x] -> (concatD [prt 0 x]) x:xs -> (concatD [prt 0 x , prt 0 xs]) instance Print IntList where prt i e = case e of Ints ns -> prPrec i 0 (concatD [doc (showString "[") , prt 0 ns , doc (showString "]")]) prtList es = case es of [] -> (concatD []) [x] -> (concatD [prt 0 x]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) instance Print Separation where prt i e = case e of SepNone -> prPrec i 0 (concatD []) SepTerm str -> prPrec i 0 (concatD [doc (showString "terminator") , prt 0 str]) SepSepar str -> prPrec i 0 (concatD [doc (showString "separator") , prt 0 str]) instance Print Arg where prt i e = case e of Arg id -> prPrec i 0 (concatD [prt 0 id]) prtList es = case es of [] -> (concatD []) x:xs -> (concatD [prt 0 x , prt 0 xs]) instance Print Exp where prt i e = case e of Cons exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString ":") , prt 0 exp]) App id exps -> prPrec i 1 (concatD [prt 0 id , prt 2 exps]) Var id -> prPrec i 2 (concatD [prt 0 id]) LitInt n -> prPrec i 2 (concatD [prt 0 n]) LitChar c -> prPrec i 2 (concatD [prt 0 c]) LitString str -> prPrec i 2 (concatD [prt 0 str]) LitDouble d -> prPrec i 2 (concatD [prt 0 d]) List exps -> prPrec i 2 (concatD [doc (showString "[") , prt 0 exps , doc (showString "]")]) prtList es = case es of [] -> (concatD []) [x] -> (concatD [prt 2 x]) [x] -> (concatD [prt 0 x]) x:xs -> (concatD [prt 2 x , prt 2 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) instance Print RHS where prt i e = case e of RHS items -> prPrec i 0 (concatD [prt 0 items]) prtList es = case es of [x] -> (concatD [prt 0 x]) x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs]) instance Print MinimumSize where prt i e = case e of MNonempty -> prPrec i 0 (concatD [doc (showString "nonempty")]) MEmpty -> prPrec i 0 (concatD []) instance Print Reg where prt i e = case e of RSeq reg0 reg -> prPrec i 2 (concatD [prt 2 reg0 , prt 3 reg]) RAlt reg0 reg -> prPrec i 1 (concatD [prt 1 reg0 , doc (showString "|") , prt 2 reg]) RMinus reg0 reg -> prPrec i 1 (concatD [prt 2 reg0 , doc (showString "-") , prt 2 reg]) RStar reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "*")]) RPlus reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "+")]) ROpt reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "?")]) REps -> prPrec i 3 (concatD [doc (showString "eps")]) RChar c -> prPrec i 3 (concatD [prt 0 c]) RAlts str -> prPrec i 3 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")]) RSeqs str -> prPrec i 3 (concatD [doc (showString "{") , prt 0 str , doc (showString "}")]) RDigit -> prPrec i 3 (concatD [doc (showString "digit")]) RLetter -> prPrec i 3 (concatD [doc (showString "letter")]) RUpper -> prPrec i 3 (concatD [doc (showString "upper")]) RLower -> prPrec i 3 (concatD [doc (showString "lower")]) RAny -> prPrec i 3 (concatD [doc (showString "char")]) BNFC-2.6.0.3/src/Main.hs0000644000000000000000000002267212100475635012601 0ustar0000000000000000{- BNF Converter: Main file Copyright (C) 2002-2010 Authors: Björn Bringert, Johan Broberg, Markus Forberg, Peter Gammie, Patrik Jansson, Antti-Juhani Kaijanaho, Ulf Norell, Michael Pellauer, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module Main where -- import Utils import CF (cfp2cf) import HaskellTop import HaskellTopGADT import ProfileTop import JavaTop import JavaTop15 import CPPTop import CSharpTop import STLTop import CTop import OCamlTop import FSharpTop import CFtoXML import Utils import Options import GetCF import MultiView (preprocessMCF, mkTestMulti, mkMakefileMulti) import System.Environment (getEnv,getArgs ) import System.Exit (exitFailure,exitSuccess) import System.Cmd (system) import Data.Char import Data.List (elemIndex, foldl') import Control.Monad (when,unless) version = "2.6a" title = unlines [ "The BNF Converter, "++version, "(c) Krasimir Angelov, Jean-Philippe Bernardy, Bjorn Bringert, Johan Broberg, Paul Callaghan, ", " Markus Forsberg, Ola Frid, Peter Gammie, Patrik Jansson, ", " Kristofer Johannisson, Antti-Juhani Kaijanaho, Ulf Norell, ", " Michael Pellauer and Aarne Ranta 2002 - 2012.", "Free software under GNU General Public License (GPL).", "Bug reports to bnfc-dev@googlegroups.com." ] main :: IO () main = do xx <- getArgs case xx of ["--numeric-version"] -> do putStrLn version exitSuccess [] -> printUsage _ | elem "-multi" xx -> do putStrLn "preprocessing multilingual BNF" let file = last xx (files,entryp) <- preprocessMCF file mapM_ mkOne [init xx ++ [f] | f <- files] mkTestMulti entryp xx file files mkMakefileMulti xx file files _ -> mkOne xx mkOne :: [String] -> IO () mkOne xx = do let args = (map (filter (not . isSpace)) xx) let file = last args if (head file == '-') then printUsage else do let name = takeWhile (/= '.') $ basename file let make = elem "-m" args let multi = elem "-multi" args let c = elem "-c" args let cpp_no_stl = elem "-cpp_no_stl" args let cpp_stl = elem "-cpp_stl" args || elem "-cpp" args let csharp = elem "-csharp" args let java14 = elem "-java1.4" args let java15 = elem "-java1.5" args || elem "-java" args let ocaml = elem "-ocaml" args let fsharp = elem "-fsharp" args let haskell = elem "-haskell" args let haskellGADT = elem "-gadt" args let profile = elem "-prof" args let alexMode = foldl' (\m arg -> case arg of "-alex1" -> Alex1 "-alex2" -> Alex2 "-alex3" -> Alex3 _ -> m ) Alex3 args alex1 = alexMode == Alex1 alex2StringSharing = elem "-sharestrings" args alex2ByteString = elem "-bytestrings" args glr = "-glr" `elem` args let xml = if elem "-xml" args then 1 else if elem "-xmlt" args then 2 else 0 let inDir = elem "-d" args let vsfiles = elem "-vs" args let wcfSupport = elem "-wcf" args let linenumbers = elem "-l" args -- for C++ STL target inPackage <- case elemIndex "-p" args of Nothing -> return Nothing Just i | i < length args - 1 -> return (Just (args!!(i+1))) _ -> do putStrLn "-p option requires an argument" printUsage let options = Options {make = make, alexMode = alexMode, inDir = inDir, shareStrings = alex2StringSharing, byteStrings = alex2ByteString, glr = if glr then GLR else Standard, xml = xml, inPackage = inPackage, lang = name, multi = multi, cnf = elem "-cnf" args, targets = targets } targets0 = [ TargetC |c] ++ [ TargetCPP | cpp_no_stl ] ++ [TargetCPP_STL | cpp_stl ] ++ [ TargetCSharp | csharp] ++ [ TargetFSharp |fsharp] ++ [TargetHaskellGADT|haskellGADT ] ++ [ TargetJava15 |java15] ++ [TargetJava |java14] ++ [TargetOCAML |ocaml] ++ [TargetProfile|profile] targets = if null targets0 then [TargetHaskell] else targets0 putStrLn title unless (length targets == 1) $ fail "Error: only one language mode may be chosen" unless (isCF (reverse file)) $ fail "Error: the input file must end with .cf" (cfp, isOk) <- tryReadCFP options file let cf = cfp2cf cfp unless isOk $ fail "Error: Failed" case () of _ | c -> makeC make name cf _ | cpp_no_stl -> makeCPP make name cf _ | cpp_stl-> makeSTL make linenumbers inPackage name cf _ | csharp -> makeCSharp make vsfiles wcfSupport inPackage cf file _ | java14 -> makeJava make name cf _ | java15 -> makeJava15 make inPackage name cf _ | ocaml -> makeOCaml options cf _ | fsharp -> makeFSharp options cf _ | profile-> makeAllProfile make alex1 False xml name cfp _ | haskellGADT -> makeAllGADT options cf _ -> makeAll options cf when (make && multi) $ do system ("cp Makefile Makefile_" ++ name) return () putStrLn "Done!" where isCF ('f':'c':'.':_) = True isCF ('f':'n':'b':'.':_) = True isCF ('f':'n':'b':'l':'.':_) = True isCF ('c':'f':'n':'b':'.':_) = True isCF _ = False printUsage = do putStrLn title putStrLn "Usage: bnfc * ? * file.cf" putStrLn "" putStrLn "Version options:" putStrLn " --numeric-version Print just the version number" putStrLn "" putStrLn "Make option:" putStrLn " -m generate Makefile" putStrLn "" putStrLn "Languages (Only one language mode may be selected.)" putStrLn " -java Output Java 1.5 code for use with JLex and CUP" putStrLn " -java1.5 Output Java 1.5 code for use with JLex and CUP (same as -java)" putStrLn " -java1.4 Output Java 1.4 code for use with JLex and CUP (before 2.5 was: -java)" putStrLn " -c Output C code for use with FLex and Bison" putStrLn " -cpp Output C++ code for use with FLex and Bison (same as -cpp_stl)" putStrLn " -cpp_stl Output C++ code for use with FLex and Bison (same as -cpp)" putStrLn " -cpp_no_stl Output C++ code (without STL) for use with FLex and Bison (before 2.5 was: -cpp)" putStrLn " and the Standard Template Library" putStrLn " -csharp Output C# code for use with GPLEX and GPPG" putStrLn " -ocaml Output OCaml code for use with ocamllex and ocamlyacc" putStrLn " -fsharp Output F# code for use with fslex and fsyacc" putStrLn " -haskell Output Haskell code for use with Alex and Happy (default)" putStrLn " -prof Output Haskell code for rules with permutation profiles" putStrLn " -gadt Output Haskell code which uses GADTs" putStrLn "" putStrLn "Special options for the Haskell back-end:" putStrLn " -d Put Haskell code in modules Lang.* instead of Lang*" putStrLn " -p Prepend to the Haskell module names." putStrLn " Dots in the module name create hierarchical modules." putStrLn " -alex1 Use Alex 1.1 as Haskell lexer tool" putStrLn " -alex2 Use Alex 2 as Haskell lexer tool" putStrLn " -alex3 Use Alex 3 as Haskell lexer tool (default)" putStrLn " -sharestrings Use string sharing in Alex 2 lexer" putStrLn " -bytestrings Use byte string in Alex 2 lexer" putStrLn " -glr Output Happy GLR parser" putStrLn " -xml Also generate a DTD and an XML printer" putStrLn " -xmlt DTD and an XML printer, another encoding" putStrLn "" putStrLn "Special options for the C++ (with STL) back-end:" putStrLn " -l Add and set line_number field for all syntax classes" putStrLn " -p Use as the C++ namespace" putStrLn "" putStrLn "Special options for the Java (v 1.5) back-end:" putStrLn " -p Prepend to the Java package name" putStrLn "" putStrLn "Special options for the C# backend:" putStrLn " -p Use as the C# namespace" putStrLn " -vs Generate Visual Studio solution/project files" putStrLn " -wcf Add support for Windows Communication Foundation, by" putStrLn " marking abstract syntax classes as DataContracts" exitFailure BNFC-2.6.0.3/src/ParBNF.y0000644000000000000000000001574112100475634012621 0ustar0000000000000000-- This Happy file was machine-generated by the BNF converter { {-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} module ParBNF where import AbsBNF import LexBNF import ErrM } %name pLGrammar LGrammar %name pLDef LDef %name pListLDef ListLDef %name pGrammar Grammar %name pListDef ListDef %name pListItem ListItem %name pDef Def %name pItem Item %name pCat Cat %name pLabel Label %name pLabelId LabelId %name pProfItem ProfItem %name pIntList IntList %name pListInteger ListInteger %name pListIntList ListIntList %name pListProfItem ListProfItem %name pSeparation Separation %name pArg Arg %name pListArg ListArg %name pExp Exp %name pExp1 Exp1 %name pExp2 Exp2 %name pListExp2 ListExp2 %name pListExp ListExp %name pListString ListString %name pListRHS ListRHS %name pRHS RHS %name pMinimumSize MinimumSize %name pReg2 Reg2 %name pReg1 Reg1 %name pReg3 Reg3 %name pReg Reg %name pListIdent ListIdent -- no lexer declaration %monad { Err } { thenM } { returnM } %tokentype { Token } %token '(' { PT _ (TS _ 1) } ')' { PT _ (TS _ 2) } '*' { PT _ (TS _ 3) } '+' { PT _ (TS _ 4) } ',' { PT _ (TS _ 5) } '-' { PT _ (TS _ 6) } '.' { PT _ (TS _ 7) } ':' { PT _ (TS _ 8) } '::=' { PT _ (TS _ 9) } ';' { PT _ (TS _ 10) } '=' { PT _ (TS _ 11) } '?' { PT _ (TS _ 12) } '[' { PT _ (TS _ 13) } ']' { PT _ (TS _ 14) } '_' { PT _ (TS _ 15) } 'char' { PT _ (TS _ 16) } 'coercions' { PT _ (TS _ 17) } 'comment' { PT _ (TS _ 18) } 'define' { PT _ (TS _ 19) } 'delimiters' { PT _ (TS _ 20) } 'digit' { PT _ (TS _ 21) } 'entrypoints' { PT _ (TS _ 22) } 'eps' { PT _ (TS _ 23) } 'internal' { PT _ (TS _ 24) } 'layout' { PT _ (TS _ 25) } 'letter' { PT _ (TS _ 26) } 'lower' { PT _ (TS _ 27) } 'nonempty' { PT _ (TS _ 28) } 'position' { PT _ (TS _ 29) } 'rules' { PT _ (TS _ 30) } 'separator' { PT _ (TS _ 31) } 'stop' { PT _ (TS _ 32) } 'terminator' { PT _ (TS _ 33) } 'token' { PT _ (TS _ 34) } 'toplevel' { PT _ (TS _ 35) } 'upper' { PT _ (TS _ 36) } 'views' { PT _ (TS _ 37) } '{' { PT _ (TS _ 38) } '|' { PT _ (TS _ 39) } '}' { PT _ (TS _ 40) } L_quoted { PT _ (TL $$) } L_ident { PT _ (TV $$) } L_integ { PT _ (TI $$) } L_charac { PT _ (TC $$) } L_doubl { PT _ (TD $$) } L_err { _ } %% String :: { String } : L_quoted { $1 } Ident :: { Ident } : L_ident { Ident $1 } Integer :: { Integer } : L_integ { (read ( $1)) :: Integer } Char :: { Char } : L_charac { (read ( $1)) :: Char } Double :: { Double } : L_doubl { (read ( $1)) :: Double } LGrammar :: { LGrammar } LGrammar : ListLDef { LGr $1 } LDef :: { LDef } LDef : Def { DefAll $1 } | ListIdent ':' Def { DefSome $1 $3 } | 'views' ListIdent { LDefView $2 } ListLDef :: { [LDef] } ListLDef : {- empty -} { [] } | LDef { (:[]) $1 } | LDef ';' ListLDef { (:) $1 $3 } Grammar :: { Grammar } Grammar : ListDef { Grammar $1 } ListDef :: { [Def] } ListDef : {- empty -} { [] } | Def { (:[]) $1 } | Def ';' ListDef { (:) $1 $3 } ListItem :: { [Item] } ListItem : {- empty -} { [] } | ListItem Item { flip (:) $1 $2 } Def :: { Def } Def : Label '.' Cat '::=' ListItem { Rule $1 $3 (reverse $5) } | 'comment' String { Comment $2 } | 'comment' String String { Comments $2 $3 } | 'internal' Label '.' Cat '::=' ListItem { Internal $2 $4 (reverse $6) } | 'token' Ident Reg { Token $2 $3 } | 'position' 'token' Ident Reg { PosToken $3 $4 } | 'entrypoints' ListIdent { Entryp $2 } | 'separator' MinimumSize Cat String { Separator $2 $3 $4 } | 'terminator' MinimumSize Cat String { Terminator $2 $3 $4 } | 'delimiters' Cat String String Separation MinimumSize { Delimiters $2 $3 $4 $5 $6 } | 'coercions' Ident Integer { Coercions $2 $3 } | 'rules' Ident '::=' ListRHS { Rules $2 $4 } | 'define' Ident ListArg '=' Exp { Function $2 (reverse $3) $5 } | 'layout' ListString { Layout $2 } | 'layout' 'stop' ListString { LayoutStop $3 } | 'layout' 'toplevel' { LayoutTop } Item :: { Item } Item : String { Terminal $1 } | Cat { NTerminal $1 } Cat :: { Cat } Cat : '[' Cat ']' { ListCat $2 } | Ident { IdCat $1 } Label :: { Label } Label : LabelId { LabNoP $1 } | LabelId ListProfItem { LabP $1 $2 } | LabelId LabelId ListProfItem { LabPF $1 $2 $3 } | LabelId LabelId { LabF $1 $2 } LabelId :: { LabelId } LabelId : Ident { Id $1 } | '_' { Wild } | '[' ']' { ListE } | '(' ':' ')' { ListCons } | '(' ':' '[' ']' ')' { ListOne } ProfItem :: { ProfItem } ProfItem : '(' '[' ListIntList ']' ',' '[' ListInteger ']' ')' { ProfIt $3 $7 } IntList :: { IntList } IntList : '[' ListInteger ']' { Ints $2 } ListInteger :: { [Integer] } ListInteger : {- empty -} { [] } | Integer { (:[]) $1 } | Integer ',' ListInteger { (:) $1 $3 } ListIntList :: { [IntList] } ListIntList : {- empty -} { [] } | IntList { (:[]) $1 } | IntList ',' ListIntList { (:) $1 $3 } ListProfItem :: { [ProfItem] } ListProfItem : ProfItem { (:[]) $1 } | ProfItem ListProfItem { (:) $1 $2 } Separation :: { Separation } Separation : {- empty -} { SepNone } | 'terminator' String { SepTerm $2 } | 'separator' String { SepSepar $2 } Arg :: { Arg } Arg : Ident { Arg $1 } ListArg :: { [Arg] } ListArg : {- empty -} { [] } | ListArg Arg { flip (:) $1 $2 } Exp :: { Exp } Exp : Exp1 ':' Exp { Cons $1 $3 } | Exp1 { $1 } Exp1 :: { Exp } Exp1 : Ident ListExp2 { App $1 $2 } | Exp2 { $1 } Exp2 :: { Exp } Exp2 : Ident { Var $1 } | Integer { LitInt $1 } | Char { LitChar $1 } | String { LitString $1 } | Double { LitDouble $1 } | '[' ListExp ']' { List $2 } | '(' Exp ')' { $2 } ListExp2 :: { [Exp] } ListExp2 : Exp2 { (:[]) $1 } | Exp2 ListExp2 { (:) $1 $2 } ListExp :: { [Exp] } ListExp : {- empty -} { [] } | Exp { (:[]) $1 } | Exp ',' ListExp { (:) $1 $3 } ListString :: { [String] } ListString : String { (:[]) $1 } | String ',' ListString { (:) $1 $3 } ListRHS :: { [RHS] } ListRHS : RHS { (:[]) $1 } | RHS '|' ListRHS { (:) $1 $3 } RHS :: { RHS } RHS : ListItem { RHS (reverse $1) } MinimumSize :: { MinimumSize } MinimumSize : 'nonempty' { MNonempty } | {- empty -} { MEmpty } Reg2 :: { Reg } Reg2 : Reg2 Reg3 { RSeq $1 $2 } | Reg3 { $1 } Reg1 :: { Reg } Reg1 : Reg1 '|' Reg2 { RAlt $1 $3 } | Reg2 '-' Reg2 { RMinus $1 $3 } | Reg2 { $1 } Reg3 :: { Reg } Reg3 : Reg3 '*' { RStar $1 } | Reg3 '+' { RPlus $1 } | Reg3 '?' { ROpt $1 } | 'eps' { REps } | Char { RChar $1 } | '[' String ']' { RAlts $2 } | '{' String '}' { RSeqs $2 } | 'digit' { RDigit } | 'letter' { RLetter } | 'upper' { RUpper } | 'lower' { RLower } | 'char' { RAny } | '(' Reg ')' { $2 } Reg :: { Reg } Reg : Reg1 { $1 } ListIdent :: { [Ident] } ListIdent : Ident { (:[]) $1 } | Ident ',' ListIdent { (:) $1 $3 } { returnM :: a -> Err a returnM = return thenM :: Err a -> (a -> Err b) -> Err b thenM = (>>=) happyError :: [Token] -> Err a happyError ts = Bad $ "syntax error at " ++ tokenPos ts ++ case ts of [] -> [] [Err _] -> " due to lexer error" _ -> " before " ++ unwords (map (id . prToken) (take 4 ts)) myLexer = tokens } BNFC-2.6.0.3/src/AbsBNF.hs0000644000000000000000000000364512100475634012746 0ustar0000000000000000module AbsBNF where -- Haskell module generated by the BNF converter newtype Ident = Ident String deriving (Eq,Ord,Show) data LGrammar = LGr [LDef] deriving (Eq,Ord,Show) data LDef = DefAll Def | DefSome [Ident] Def | LDefView [Ident] deriving (Eq,Ord,Show) data Grammar = Grammar [Def] deriving (Eq,Ord,Show) data Def = Rule Label Cat [Item] | Comment String | Comments String String | Internal Label Cat [Item] | Token Ident Reg | PosToken Ident Reg | Entryp [Ident] | Separator MinimumSize Cat String | Terminator MinimumSize Cat String | Delimiters Cat String String Separation MinimumSize | Coercions Ident Integer | Rules Ident [RHS] | Function Ident [Arg] Exp | Layout [String] | LayoutStop [String] | LayoutTop deriving (Eq,Ord,Show) data Item = Terminal String | NTerminal Cat deriving (Eq,Ord,Show) data Cat = ListCat Cat | IdCat Ident deriving (Eq,Ord,Show) data Label = LabNoP LabelId | LabP LabelId [ProfItem] | LabPF LabelId LabelId [ProfItem] | LabF LabelId LabelId deriving (Eq,Ord,Show) data LabelId = Id Ident | Wild | ListE | ListCons | ListOne deriving (Eq,Ord,Show) data ProfItem = ProfIt [IntList] [Integer] deriving (Eq,Ord,Show) data IntList = Ints [Integer] deriving (Eq,Ord,Show) data Separation = SepNone | SepTerm String | SepSepar String deriving (Eq,Ord,Show) data Arg = Arg Ident deriving (Eq,Ord,Show) data Exp = Cons Exp Exp | App Ident [Exp] | Var Ident | LitInt Integer | LitChar Char | LitString String | LitDouble Double | List [Exp] deriving (Eq,Ord,Show) data RHS = RHS [Item] deriving (Eq,Ord,Show) data MinimumSize = MNonempty | MEmpty deriving (Eq,Ord,Show) data Reg = RSeq Reg Reg | RAlt Reg Reg | RMinus Reg Reg | RStar Reg | RPlus Reg | ROpt Reg | REps | RChar Char | RAlts String | RSeqs String | RDigit | RLetter | RUpper | RLower | RAny deriving (Eq,Ord,Show) BNFC-2.6.0.3/src/Options.hs0000644000000000000000000000166712100475634013350 0ustar0000000000000000module Options where data Target = TargetC | TargetCPP |TargetCPP_STL | TargetCSharp | TargetFSharp |TargetHaskell |TargetHaskellGADT | TargetJava15 |TargetJava |TargetOCAML |TargetProfile deriving Eq -- | Which version of Alex is targeted? data AlexMode = Alex1 | Alex2 | Alex3 deriving Eq data HappyMode = Standard | GLR deriving Eq data SharedOptions = Options { targets :: [Target], make :: Bool, alexMode :: AlexMode, inDir :: Bool, shareStrings :: Bool, byteStrings :: Bool, glr :: HappyMode, xml :: Int, inPackage :: Maybe String, -- ^ The hierarchical package to put -- the modules in, or Nothing. lang :: String, -- ^ Prefix to use in module names multi :: Bool, cnf :: Bool -- ^ Generate CNF-like tables? } anyTarget opts vs = any (isOpt opts) vs where isOpt opts v = elem v $ targets opts BNFC-2.6.0.3/src/formats/0000755000000000000000000000000012100475634013022 5ustar0000000000000000BNFC-2.6.0.3/src/formats/CFtoLatex.hs0000644000000000000000000002312512100475634015212 0ustar0000000000000000{- BNF Converter: Latex Generator Copyright (C) 2004 Author: Markus Forberg, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoLatex (cfToLatex)where import CF import AbsBNF (Reg (..)) import Utils import Data.List (nub,intersperse) cfToLatex :: String -> CF -> String cfToLatex name cf = unlines [ "\\batchmode", beginDocument name, macros, introduction, prtTerminals name cf, prtBNF name cf, endDocument ] introduction :: String introduction = concat [ "\nThis document was automatically generated by ", "the {\\em BNF-Converter}.", " It was generated together with the lexer, the parser, and the", " abstract syntax module, which guarantees that the document", " matches with the implementation of the language (provided no", " hand-hacking has taken place).\n" ] prtTerminals :: String -> CF -> String prtTerminals name cf = unlines [ "\\section*{The lexical structure of " ++ name ++ "}", identSection cf, "\\subsection*{Literals}", prtLiterals name cf, unlines (map prtOwnToken (tokenPragmas cf)), "\\subsection*{Reserved words and symbols}", prtReserved name cf, prtSymb name cf, "\\subsection*{Comments}", prtComments $ comments cf ] identSection cf = if not (hasIdent cf) then [] else unlines [ "\\subsection*{Identifiers}", prtIdentifiers ] prtIdentifiers :: String prtIdentifiers = unlines [ "Identifiers \\nonterminal{Ident} are unquoted strings beginning with a letter,", "followed by any combination of letters, digits, and the characters {\\tt \\_ '},", "reserved words excluded." ] prtLiterals :: String -> CF -> String prtLiterals name cf = unlines $ map stringLit $ filter (`notElem` ["Ident"]) $ literals cf stringLit :: String -> String stringLit cat = unlines $ case cat of "Char" -> ["Character literals \\nonterminal{Char}\\ have the form", "\\terminal{'}$c$\\terminal{'}, where $c$ is any single character.", "" ] "String" -> ["String literals \\nonterminal{String}\\ have the form", "\\terminal{\"}$x$\\terminal{\"}, where $x$ is any sequence of any characters", "except \\terminal{\"}\\ unless preceded by \\verb6\\6.", ""] "Integer" -> ["Integer literals \\nonterminal{Int}\\ are nonempty sequences of digits.", ""] "Double" -> ["Double-precision float literals \\nonterminal{Double}\\ have the structure", "indicated by the regular expression" +++ "$\\nonterminal{digit}+ \\mbox{{\\it `.'}} \\nonterminal{digit}+ (\\mbox{{\\it `e'}} \\mbox{{\\it `-'}}? \\nonterminal{digit}+)?$ i.e.\\", "two sequences of digits separated by a decimal point, optionally", "followed by an unsigned or negative exponent.", ""] _ -> [] prtOwnToken (name,reg) = unlines [name +++ "literals are recognized by the regular expression", "\\(" ++ latexRegExp reg ++ "\\)" ] prtComments :: ([(String,String)],[String]) -> String prtComments (xs,ys) = concat [ if (null ys) then "There are no single-line comments in the grammar. \\\\" else "Single-line comments begin with " ++ sing ++". \\\\", if (null xs) then "There are no multiple-line comments in the grammar." else "Multiple-line comments are enclosed with " ++ mult ++"." ] where sing = concat $ intersperse ", " $ map (symbol.prt) ys mult = concat $ intersperse ", " $ map (\(x,y) -> (symbol (prt x)) ++ " and " ++ (symbol (prt y))) xs prtSymb :: String -> CF -> String prtSymb name cf = case symbols cf of [] -> "\nThere are no symbols in " ++ name ++ ".\\\\\n" xs -> "The symbols used in " ++ name ++ " are the following: \\\\\n" ++ (tabular 3 $ three $ map (symbol.prt) xs) prtReserved :: String -> CF -> String prtReserved name cf = case reservedWords cf of [] -> stringRes name ++ "\nThere are no reserved words in " ++ name ++ ".\\\\\n" xs -> stringRes name ++ (tabular 3 $ three $ map (reserved.prt) xs) stringRes :: String -> String stringRes name = concat ["The set of reserved words is the set of terminals ", "appearing in the grammar. Those reserved words ", "that consist of non-letter characters are called symbols, and ", "they are treated in a different way from those that ", "are similar to identifiers. The lexer ", "follows rules familiar from languages ", "like Haskell, C, and Java, including longest match ", "and spacing conventions.", "\n\n", "The reserved words used in " ++ name ++ " are the following: \\\\\n"] three :: [String] -> [[String]] three [] = [] three [x] = [[x,[],[]]] three [x,y] = [[x,y,[]]] three (x:y:z:xs) = [x,y,z] : three xs prtBNF :: String -> CF -> String prtBNF name cf = unlines [ "\\section*{The syntactic structure of " ++ name ++"}", "Non-terminals are enclosed between $\\langle$ and $\\rangle$. ", "The symbols " ++ arrow ++ " (production), " ++ delimiter ++" (union) ", "and " ++ empty ++ " (empty rule) belong to the BNF notation. ", "All other symbols are terminals.\\\\", prtRules (ruleGroups cf) ] prtRules :: [(Cat,[Rule])] -> String prtRules [] = [] prtRules ((c,[]):xs) = tabular 3 [[nonterminal c,arrow,[]]] ++ prtRules xs prtRules ((c,(r:rs)):xs) = tabular 3 ([[nonterminal c,arrow,prtSymbols $ rhsRule r]] ++ [[[],delimiter,prtSymbols (rhsRule y)] | y <- rs]) ++ prtRules xs prtSymbols :: [Either Cat String] -> String prtSymbols [] = empty prtSymbols xs = foldr (+++) [] (map p xs) where p (Left r) = nonterminal r --- (prt r) p (Right r) = terminal (prt r) prt :: String -> String prt [] = [] prt (c:xs) | elem c "$&%#_{}^" = "\\" ++ [c] ++ prt xs | elem c "+=|<>-" = "{$" ++ [c] ++ "$}" ++ prt xs | c == '\\' = "$\\backslash$" | c == '~' = "\\~{}" | otherwise = c : prt xs macros :: String macros = "\\newcommand{\\emptyP}{\\mbox{$\\epsilon$}}" ++++ "\\newcommand{\\terminal}[1]{\\mbox{{\\texttt {#1}}}}" ++++ "\\newcommand{\\nonterminal}[1]{\\mbox{$\\langle \\mbox{{\\sl #1 }} \\! \\rangle$}}" ++++ "\\newcommand{\\arrow}{\\mbox{::=}}" ++++ "\\newcommand{\\delimit}{\\mbox{$|$}}" ++++ "\\newcommand{\\reserved}[1]{\\mbox{{\\texttt {#1}}}}" ++++ "\\newcommand{\\literal}[1]{\\mbox{{\\texttt {#1}}}}" ++++ "\\newcommand{\\symb}[1]{\\mbox{{\\texttt {#1}}}}" reserved :: String -> String reserved s = "{\\reserved{" ++ s ++ "}}" literal :: String -> String literal s = "{\\literal{" ++ s ++ "}}" empty :: String empty = "{\\emptyP}" symbol :: String -> String symbol s = "{\\symb{" ++ s ++ "}}" tabular :: Int -> [[String]] -> String tabular n xs = "\n\\begin{tabular}{" ++ concat (replicate n "l") ++ "}\n" ++ concat (map (\(a:as) -> foldr (+++) "\\\\\n" (a:(map ('&':) as))) xs) ++ "\\end{tabular}\\\\\n" terminal :: String -> String terminal s = "{\\terminal{" ++ s ++ "}}" nonterminal :: String -> String nonterminal s = "{\\nonterminal{" ++ identCat (mkId s) ++ "}}" where mkId = map mk mk c = case c of '_' -> '-' --- _ -> c arrow :: String arrow = " {\\arrow} " delimiter :: String delimiter = " {\\delimit} " beginDocument :: String -> String beginDocument name = "%This Latex file is machine-generated by the BNF-converter\n" ++++ "\\documentclass[a4paper,11pt]{article}" ++++ "\\author{BNF-converter}" ++++ "\\title{The Language " ++ name ++ "}" ++++ -- "\\usepackage{isolatin1}" ++++ "\\setlength{\\parindent}{0mm}" ++++ "\\setlength{\\parskip}{1mm}" ++++ "\\begin{document}\n" ++++ "\\maketitle\n" endDocument :: String endDocument = "\n\\end{document}\n" latexRegExp :: Reg -> String latexRegExp = rex (0 :: Int) where rex i e = case e of RSeq reg0 reg -> ifPar i 2 $ rex 2 reg0 +++ rex 2 reg RAlt reg0 reg -> ifPar i 1 $ rex 1 reg0 +++ "\\mid" +++ rex 1 reg RMinus reg0 reg -> ifPar i 1 $ rex 2 reg0 +++ "-" +++ rex 2 reg RStar reg -> rex 3 reg ++ "*" RPlus reg -> rex 3 reg ++ "+" ROpt reg -> rex 3 reg ++ "?" REps -> "\\epsilon" RChar c -> "\\mbox{`" ++ prt [c] ++ "'}" RAlts str -> "[" ++ "\\mbox{``" ++ prt str ++ "''}" ++ "]" RSeqs str -> "\\{" ++ "\\mbox{``" ++ prt str ++ "''}" ++ "\\}" RDigit -> "{\\nonterminal{digit}}" RLetter -> "{\\nonterminal{letter}}" RUpper -> "{\\nonterminal{upper}}" RLower -> "{\\nonterminal{lower}}" RAny -> "{\\nonterminal{anychar}}" ifPar i j s = if i > j then "(" ++ s ++ ")" else s BNFC-2.6.0.3/src/formats/OOAbstract.hs0000644000000000000000000001075612100475634015370 0ustar0000000000000000{- BNF Converter: Datastructure for object-oriented abstract syntax generators Copyright (C) 2006 Author: Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module defines a data structure that is used for generating abstract syntax in cpp_stl. It should be used in other STL modules as well, and could be used for object-oriented languages in general, to avoid duplicated work. Author : Aarne Ranta (aarne@cs.chalmers.se) License : GPL (GNU General Public License) Created : 29 August, 2006 Modified : 29 August, 2006 / Aarne Ranta ************************************************************** -} module OOAbstract where import CF import Utils((+++),(++++)) import NamedVariables import Data.List import Data.Char(toLower) -- A datastructure more appropriate than CF data CAbs = CAbs { tokentypes :: [Cat], -- user non-position token types listtypes :: [(Cat,Bool)], -- list types used, whether of classes absclasses :: [Cat], -- grammar-def cats, normalized names conclasses :: [Fun], -- constructors, except list ones signatures :: [(Cat,[CAbsRule])], -- rules for each class, incl. pos tokens postokens :: [Cat], -- position token types defineds :: [Fun] -- defined (non-)constructors } -- (valcat,(constr,args)), True = is class (not basic), class variable stored type CAbsRule = (Fun,[(Cat,Bool,String)]) -- all those names that denote classes in C++ allClasses :: CAbs -> [Cat] allClasses ca = absclasses ca ++ conclasses ca ++ map fst (listtypes ca) ++ postokens ca -- all those names that denote non-class types in C++ allNonClasses :: CAbs -> [Cat] allNonClasses ca = map fst basetypes ++ tokentypes ca cf2cabs :: CF -> CAbs cf2cabs cf = CAbs { tokentypes = toks, listtypes = [(c, snd (status (drop 4 c))) | -- remove "List" from "ListC" c <- map (normCat . identCat) lists], absclasses = nub $ map normCat cats, conclasses = [f | Just f <- map testRule (rulesOfCF cf)], signatures = posdata ++ map normSig (cf2data cf), postokens = pos, defineds = defs } where (pos,base) = partition (isPositionCat cf) $ fst (unzip (tokenPragmas cf)) (lists,cats) = partition isList $ allCats cf toks = map normCat base testRule (Rule f c r) | isList c = Nothing | f == "_" = Nothing | otherwise = Just f normSig (c,fcs) = (identCat c,[(f, classVars (map (status . identCat) cs)) | (f,cs) <- fcs]) posdata = [("Visitable", -- to give superclass [(c,[("String",False,"string_"),("Integer",False,"integer_")])]) | c<-pos] status cat = (cat, notElem cat (map fst basetypes ++ toks)) defs = [f | FunDef f _ _ <- pragmasOfCF cf] classVars :: [(Cat,Bool)] -> [(Cat,Bool,String)] classVars cs = [(c,b,s) | ((c,b),s) <- zip cs (vars [] (map (classVar . fst) cs))] --- creating new names is quadratic, but parameter lists are short --- this should conform with Michael's naming vars seen vv = case vv of [] -> vv v:vs -> case length (filter (==v) seen) of 0 | elem v vs -> (v ++ "1"): vars (v:seen) vs 0 -> v : vars (v:seen) vs n -> (v ++ show (n+1)) : vars (v:seen) vs basetypes = [ ("Integer","int"), ("Char", "char"), ("Double", "double"), ("String", "std::string"), ("Ident", "std::string") ] isBaseType :: CAbs -> Cat -> Bool isBaseType cf c = elem c $ tokentypes cf ++ map fst basetypes classVar :: Cat -> String classVar c = map toLower c ++ "_" pointerIf :: Bool -> String -> String pointerIf b v = if b then "*" ++ v else v BNFC-2.6.0.3/src/formats/CFtoTxt.hs0000644000000000000000000002004512100475634014712 0ustar0000000000000000{- BNF Converter: Latex Generator Copyright (C) 2004 Author: Markus Forberg, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoTxt (cfToTxt)where import CF import AbsBNF (Reg (..)) import Utils import Data.List (nub,intersperse) cfToTxt :: String -> CF -> String cfToTxt name cf = unlines [ beginDocument name, introduction, prtTerminals name cf, prtBNF name cf ] introduction :: String introduction = concat [ "\nThis document was automatically generated by ", "the //BNF-Converter//.", " It was generated together with the lexer, the parser, and the", " abstract syntax module, which guarantees that the document", " matches with the implementation of the language (provided no", " hand-hacking has taken place).\n" ] prtTerminals :: String -> CF -> String prtTerminals name cf = unlines [ "==The lexical structure of " ++ name ++ "==", identSection cf, "===Literals===", prtLiterals name cf, unlines (map prtOwnToken (tokenPragmas cf)), "===Reserved words and symbols===", prtReserved name cf, prtSymb name cf, "===Comments===", prtComments $ comments cf ] identSection cf = if not (hasIdent cf) then [] else unlines [ "===Identifiers===", prtIdentifiers ] prtIdentifiers :: String prtIdentifiers = unlines [ "Identifiers //Ident// are unquoted strings beginning with a letter,", "followed by any combination of letters, digits, and the characters ``_ '``", "reserved words excluded." ] prtLiterals :: String -> CF -> String prtLiterals name cf = unlines $ map stringLit $ filter (`notElem` ["Ident"]) $ literals cf stringLit :: String -> String stringLit cat = unlines $ case cat of "Char" -> ["Character literals //Char// have the form", "``'``//c//``'``, where //c// is any single character.", "" ] "String" -> ["String literals //String// have the form", "``\"``//x//``\"``}, where //x// is any sequence of any characters", "except ``\"`` unless preceded by ``\\``.", ""] "Integer" -> ["Integer literals //Integer// are nonempty sequences of digits.", ""] "Double" -> ["Double-precision float literals //Double// have the structure", "indicated by the regular expression" +++ "``digit+ '.' digit+ ('e' ('-')? digit+)?`` i.e.\\", "two sequences of digits separated by a decimal point, optionally", "followed by an unsigned or negative exponent.", ""] _ -> [] prtOwnToken (name,reg) = unlines [name +++ "literals are recognized by the regular expression", "```" ++ latexRegExp reg ++ "```" ] prtComments :: ([(String,String)],[String]) -> String prtComments (xs,ys) = concat [ if (null ys) then "There are no single-line comments in the grammar." else "Single-line comments begin with " ++ sing ++".", if (null xs) then "There are no multiple-line comments in the grammar." else "Multiple-line comments are enclosed with " ++ mult ++"." ] where sing = concat $ intersperse ", " $ map (symbol.prt) ys mult = concat $ intersperse ", " $ map (\(x,y) -> (symbol (prt x)) ++ " and " ++ (symbol (prt y))) xs prtSymb :: String -> CF -> String prtSymb name cf = case symbols cf of [] -> "\nThere are no symbols in " ++ name ++ ".\n" xs -> "The symbols used in " ++ name ++ " are the following:\n" ++ (tabular 4 $ three $ map (symbol.prt) xs) prtReserved :: String -> CF -> String prtReserved name cf = case reservedWords cf of [] -> stringRes name ++ "\nThere are no reserved words in " ++ name ++ ".\n" xs -> stringRes name ++ (tabular 4 $ three $ map quote xs) stringRes :: String -> String stringRes name = concat ["The set of reserved words is the set of terminals ", "appearing in the grammar. Those reserved words ", "that consist of non-letter characters are called symbols, and ", "they are treated in a different way from those that ", "are similar to identifiers. The lexer ", "follows rules familiar from languages ", "like Haskell, C, and Java, including longest match ", "and spacing conventions.", "\n\n", "The reserved words used in " ++ name ++ " are the following:\n"] three :: [String] -> [[String]] three [] = [] three [x] = [[x,[],[],[]]] three [x,y] = [[x,y,[],[]]] three [x,y,z] = [[x,y,z,[]]] three (x:y:z:u:xs) = [x,y,z,u] : three xs prtBNF :: String -> CF -> String prtBNF name cf = unlines [ "==The syntactic structure of " ++ name ++"==", "Non-terminals are enclosed between < and >. ", "The symbols " ++ arrow ++ " (production), " ++ delimiter ++" (union) ", "and " ++ empty ++ " (empty rule) belong to the BNF notation. ", "All other symbols are terminals.", "", prtRules (ruleGroups cf) ] prtRules :: [(Cat,[Rule])] -> String prtRules [] = [] prtRules ((c,[]):xs) = tabular 3 [[nonterminal c,arrow,[]]] ++ prtRules xs prtRules ((c,(r:rs)):xs) = tabular 3 ([[nonterminal c,arrow,prtSymbols $ rhsRule r]] ++ [[[],delimiter,prtSymbols (rhsRule y)] | y <- rs]) ++ --- "\n\n" ++ --- with empty lines good for latex, bad for html prtRules xs prtSymbols :: [Either Cat String] -> String prtSymbols [] = empty prtSymbols xs = foldr (+++) [] (map p xs) where p (Left r) = nonterminal r p (Right r) = terminal r prt :: String -> String prt s = s reserved :: String -> String reserved s = "{\\reserved{" ++ s ++ "}}" literal :: String -> String literal s = "{\\literal{" ++ s ++ "}}" empty :: String empty = "**eps**" symbol :: String -> String symbol s = s tabular :: Int -> [[String]] -> String tabular n xs = unlines [unwords (intersperse "|" (" " : x)) | x <- xs] terminal :: String -> String terminal s = "``" ++ s ++ "``" nonterminal :: String -> String nonterminal s = "//" ++ s ++ "//" arrow :: String arrow = "->" delimiter :: String delimiter = " **|** " beginDocument :: String -> String beginDocument name = unlines [ "The Language " ++ name, "BNF Converter", "", "", "%This txt2tags file is machine-generated by the BNF-converter", "%Process by txt2tags to generate html or latex", "" ] latexRegExp :: Reg -> String latexRegExp = quote . rex (0 :: Int) where rex i e = case e of RSeq reg0 reg -> ifPar i 2 $ rex 2 reg0 +++ rex 2 reg RAlt reg0 reg -> ifPar i 1 $ rex 1 reg0 +++ "|" +++ rex 1 reg RMinus reg0 reg -> ifPar i 1 $ rex 2 reg0 +++ "-" +++ rex 2 reg RStar reg -> rex 3 reg ++ "*" RPlus reg -> rex 3 reg ++ "+" ROpt reg -> rex 3 reg ++ "?" REps -> "eps" RChar c -> "'" ++ [c] ++ "'" RAlts str -> "[\"" ++ str ++ "\"]" RSeqs str -> "{\"" ++ str ++ "\"}" RDigit -> "digit" RLetter -> "letter" RUpper -> "upper" RLower -> "lower" RAny -> "char" ifPar i j s = if i > j then "(" ++ s ++ ")" else s quote s = "``" ++ s ++ "``" BNFC-2.6.0.3/src/formats/NamedVariables.hs0000644000000000000000000000723012100475634016235 0ustar0000000000000000 {- BNF Converter: Named instance variables Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module provides support for languages which need named instance variables. (IE Java, C, C++) It provides a data type to represent the name mapping and utility functions to work with it. Variables are grouped and numbered in a nice way. Author : Michael Pellauer (pellauer@cs.chalmers.se) ************************************************************** -} module NamedVariables where import CF import Data.Char (toLower) import Data.List (nub) type IVar = (String, Int) --The type of an instance variable --and a # unique to that type type UserDef = String --user-defined types --A symbol-mapping environment. type SymEnv = [(String, String)] --Converts a list of categories into their types to be used as instance variables. getVars :: [Cat] -> [IVar] getVars [] = [] getVars cs = foldl addVar [] (map identCat cs) where addVar vs c = addVar' vs 0 c addVar' [] n c = [(c, n)] addVar' (i@(t,x):is) n c = if c == t then if x == 0 then (t, 1) : (addVar' is 2 c) else i : (addVar' is (x+1) c) else i : (addVar' is n c) --Given a rule's definition, it goes through and nicely the variables by type. numVars :: [(String, Int)] -> [Either String b] -> [Either String b] numVars _env [] = [] numVars env ((Right f) : fs) = (Right f) : (numVars env fs) numVars env ((Left f) : fs) = case lookup f' env of Nothing -> (Left f') : (numVars ((f',1):env) fs) Just n -> (Left $ f' ++ (show $ n + 1)) : (numVars ((f',n+1):env) fs) where f' = varName (normCat (identCat f)) --This makes numbers a little nicer. --If there's only one variable of a type we drop the redundant _1 label. --(Actually here we add _1 labels to variables that need it, but the effect -- is the same.) fixOnes [] = [] fixOnes ((Right f): fs) = (Right f) : (fixOnes fs) fixOnes ((Left f) : fs) = if elem (Left (f ++ "2")) fs then (Left (f ++ "1")) : (fixOnes fs) else (Left f) : (fixOnes fs) --This fixes the problem with coercions. fixCoercions :: [(Cat, [Rule])] -> [(Cat, [Rule])] fixCoercions rs = nub (fixAll rs rs) where fixCoercion :: Cat -> [(Cat, [Rule])] -> [Rule] fixCoercion _ [] = [] fixCoercion cat ((c,rules):cats) = if (normCat c) == (normCat cat) then rules ++ (fixCoercion cat cats) else fixCoercion cat cats fixAll :: [(Cat, [Rule])] -> [(Cat, [Rule])] -> [(Cat, [Rule])] fixAll _ [] = [] fixAll top ((cat,rules):cats) = if isCoercion cat then fixAll top cats else (normCat cat, fixCoercion cat top) : (fixAll top cats) --A generic variable name for C-like languages. varName c = (map toLower c) ++ "_" --this makes var names a little cleaner. showNum n = if n == 0 then [] else (show n) BNFC-2.6.0.3/src/formats/c-sharp/0000755000000000000000000000000012100475635014360 5ustar0000000000000000BNFC-2.6.0.3/src/formats/c-sharp/RegToGPLEX.hs0000644000000000000000000000454112100475635016540 0ustar0000000000000000module RegToGPLEX (printRegGPLEX) where -- modified from RegToFlex import AbsBNF import Data.Char -- the top-level printing method printRegGPLEX :: Reg -> String printRegGPLEX = render . prt 0 -- you may want to change render and parenth render :: [String] -> String render = rend (0::Int) where rend i ss = case ss of "[" :ts -> cons "[" $ rend i ts "(" :ts -> cons "(" $ rend i ts t : "," :ts -> cons t $ space "," $ rend i ts t : ")" :ts -> cons t $ cons ")" $ rend i ts t : "]" :ts -> cons t $ cons "]" $ rend i ts t :ts -> space t $ rend i ts _ -> "" cons s t = s ++ t new i s = s space t s = if null s then t else t ++ s parenth :: [String] -> [String] parenth ss = ["("] ++ ss ++ [")"] -- the printer class does the job class Print a where prt :: Int -> a -> [String] prtList :: [a] -> [String] prtList = concat . map (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = [[c]] prtList s = map (concat . prt 0) s prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (concat [prt 2 reg0 , prt 3 reg]) RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg]) RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg]) RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]]) RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]]) ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]]) REps -> prPrec i 3 (["[^.]"]) RChar c -> prPrec i 3 (prt 0 [mkEsc [c]]) RAlts str -> prPrec i 3 (concat [["["], prt 0 $ mkEsc str, ["]"]]) RSeqs str -> prPrec i 2 (concat (map (prt 0) $ mkEsc str)) RDigit -> prPrec i 3 (concat [["{digit}"]]) RLetter -> prPrec i 3 (concat [["{alpha}"]]) RUpper -> prPrec i 3 (concat [["{alphaCapital}"]]) RLower -> prPrec i 3 (concat [["{alphaSmall}"]]) RAny -> prPrec i 3 (concat [["."]]) -- Handle special characters in regular expressions. mkEsc :: String -> String mkEsc = concatMap escChar where escChar c | c `elem` "$+-*=<>[](){}!?.,;:^~|&%#/\\$_@\"" = '\\':[c] | otherwise = [c] BNFC-2.6.0.3/src/formats/c-sharp/CSharpTop.hs0000644000000000000000000003621312100475635016564 0ustar0000000000000000{- BNF Converter: C# Main file Copyright (C) 2006-2007 Author: Johan Broberg Modified from STLTop 2006. 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : C# Main file Author : Johan Broberg (johan@pontemonti.com) License : GPL (GNU General Public License) Created : 20 November, 2006 Modified : 8 January, 2007 by Johan Broberg ************************************************************** -} module CSharpTop (makeCSharp) where import Utils import CF import OOAbstract import CAbstoCSharpAbs import CFtoGPLEX import CFtoGPPG import CAbstoCSharpVisitSkeleton import CAbstoCSharpAbstractVisitSkeleton import CFtoCSharpPrinter import CFtoLatex import CSharpUtils import Data.Char import System.Exit (exitFailure) import System.Environment (getEnv) import System.Directory import System.IO import System.IO.Error (catchIOError) import System.Process import Data.Maybe import Data.Char import Control.Monad.ST -- Control.Monad.State makeCSharp :: Bool -- Makefile -> Bool -- Visual Studio files -> Bool -- Windows Communication Foundation support -> Maybe Namespace -- C# namespace to use -> CF -> FilePath -> IO () makeCSharp make vsfiles wcfSupport maybenamespace cf file = do let namespace = fromMaybe (filepathtonamespace file) maybenamespace cabs = cf2cabs cf absyn = cabs2csharpabs namespace cabs wcfSupport (gplex, env) = cf2gplex namespace cf gppg = cf2gppg namespace cf env skeleton = cabs2csharpvisitskeleton namespace cabs absSkeleton = cabs2csharpAbstractVisitSkeleton namespace cabs printer = cf2csharpprinter namespace cf latex = cfToLatex namespace cf writeFileRep "Absyn.cs" absyn writeFileRep (namespace ++ ".l") gplex putStrLn " (Tested with GPLEX RC1)" writeFileRep (namespace ++ ".y") gppg putStrLn " (Tested with GPPG 1.0)" writeFileRep "AbstractVisitSkeleton.cs" absSkeleton writeFileRep "VisitSkeleton.cs" skeleton writeFileRep "Printer.cs" printer writeFileRep "Test.cs" (csharptest namespace cf) writeFileRep (namespace ++ ".tex") latex if vsfiles then (writeVisualStudioFiles namespace) else return () if make then (writeMakefile namespace) else return () writeMakefile :: Namespace -> IO () writeMakefile namespace = do writeFileRep "Makefile" makefile putStrLn "" putStrLn "-----------------------------------------------------------------------------" putStrLn "Generated Makefile, which uses mono. You may want to modify the paths to" putStrLn "GPLEX and GPPG - unless you are sure that they are globally accessible (the" putStrLn "default commands are \"mono gplex.exe\" and \"mono gppg.exe\", respectively." putStrLn "The Makefile assumes that ShiftReduceParser.dll is located in ./bin and that" putStrLn "is also where test.exe will be generated." putStrLn "-----------------------------------------------------------------------------" putStrLn "" where makefile = unlines [ "MONO = mono", "MONOC = gmcs", "MONOCFLAGS = -optimize -reference:${PARSERREF}", "GPLEX = ${MONO} gplex.exe", "GPPG = ${MONO} gppg.exe", "LATEX = latex", "DVIPS = dvips", "PARSERREF = bin/ShiftReduceParser.dll", -- Apparently GPLEX outputs filenames in lowercase, so scanner.cs is supposed to be like that! "CSFILES = Absyn.cs Parser.cs Printer.cs scanner.cs Test.cs VisitSkeleton.cs", "", "all: test " ++ namespace ++ ".ps", "", "clean:", -- peteg: don't nuke what we generated - move that to the "vclean" target. "\trm -f " ++ namespace ++ ".dvi " ++ namespace ++ ".aux " ++ namespace ++ ".log " ++ namespace ++ ".ps test", "", "distclean:", "\trm -f ${CSFILES} " ++ namespace ++ ".l " ++ namespace ++ ".y " ++ namespace ++ ".tex " ++ namespace ++ ".dvi " ++ namespace ++ ".aux " ++ namespace ++ ".log " ++ namespace ++ ".ps test Makefile", "", "test: Parser.cs Scanner.cs", "\t@echo \"Compiling test...\"", "\t${MONOC} ${MONOCFLAGS} -out:bin/test.exe ${CSFILES}", "", "Scanner.cs: " ++ namespace ++ ".l", "\t${GPLEX} /out:Scanner.cs " ++ namespace ++ ".l", "", "Parser.cs: " ++ namespace ++ ".y", "\t${GPPG} /gplex " ++ namespace ++ ".y > Parser.cs", "", "" ++ namespace ++ ".dvi: " ++ namespace ++ ".tex", "\t${LATEX} " ++ namespace ++ ".tex", "", "" ++ namespace ++ ".ps: " ++ namespace ++ ".dvi", "\t${DVIPS} " ++ namespace ++ ".dvi -o " ++ namespace ++ ".ps", "" ] writeVisualStudioFiles :: Namespace -> IO () writeVisualStudioFiles namespace = do guid <- projectguid writeFileRep (namespace ++ ".csproj") (csproj guid) writeFileRep (namespace ++ ".sln") (sln guid) writeFileRep "run-gp.bat" batchfile putStrLn "" putStrLn "-----------------------------------------------------------------------------" putStrLn "Visual Studio solution (.sln) and project (.csproj) files were written." putStrLn "The project file has a reference to GPLEX/GPPG's ShiftReduceParser. You will" putStrLn "have to either copy this file to bin\\ShiftReduceParser.dll or change the" putStrLn "reference so that it points to the right location (you can do this from" putStrLn "within Visual Studio)." putStrLn "Additionally, the project includes Parser.cs and Scanner.cs. These have not" putStrLn "been generated yet. You can use the run-gp.bat file to generate them, but" putStrLn "note that it requires gppg and gplex to be in your PATH." putStrLn "-----------------------------------------------------------------------------" putStrLn "" where batchfile = unlines [ "@echo off", "gppg /gplex " ++ namespace ++ ".y > Parser.cs", "gplex /verbose /out:Scanner.cs " ++ namespace ++ ".l" ] sln guid = unlines [ "Microsoft Visual Studio Solution File, Format Version 9.00", "# Visual Studio 2005", "Project(\"{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}\") = \"" ++ namespace ++ "\", \"" ++ namespace ++ ".csproj\", \"" ++ guid ++ "\"", "EndProject", "Global", " GlobalSection(SolutionConfigurationPlatforms) = preSolution", " Debug|Any CPU = Debug|Any CPU", " Release|Any CPU = Release|Any CPU", " EndGlobalSection", " GlobalSection(ProjectConfigurationPlatforms) = postSolution", " " ++ guid ++ ".Debug|Any CPU.ActiveCfg = Debug|Any CPU", " " ++ guid ++ ".Debug|Any CPU.Build.0 = Debug|Any CPU", " " ++ guid ++ ".Release|Any CPU.ActiveCfg = Release|Any CPU", " " ++ guid ++ ".Release|Any CPU.Build.0 = Release|Any CPU", " EndGlobalSection", " GlobalSection(SolutionProperties) = preSolution", " HideSolutionNode = FALSE", " EndGlobalSection", "EndGlobal" ] csproj guid = unlines [ "", "", " ", " Debug", " AnyCPU", " 8.0.50727", " 2.0", " " ++ guid ++ "", " Library", " Properties", " " ++ namespace ++ "", " " ++ namespace ++ "", " ", " ", " ", " ", " true", " full", " false", " bin\\Debug\\", " DEBUG;TRACE", " prompt", " 4", " ", " ", " pdbonly", " true", " bin\\Release\\", " TRACE", " prompt", " 4", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " False", " bin\\ShiftReduceParser.dll", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", "" ] csharptest :: Namespace -> CF -> String csharptest namespace cf = unlines [ "/*** Compiler Front-End Test automatically generated by the BNF Converter ***/", "/* */", "/* This test will parse a file, print the abstract syntax tree, and then */", "/* pretty-print the result. */", "/* */", "/****************************************************************************/", "using System;", "using System.IO;", "using " ++ namespace ++ ".Absyn;", "", "namespace " ++ namespace, "{", " public class Test", " {", " public static void Main(string[] args)", " {", " if (args.Length > 0)", " {", " Stream stream = File.OpenRead(args[0]);", " /* The default entry point is used. For other options see class Parser */", " Parser parser = new Parser();", " Scanner scanner = Scanner.CreateScanner(stream);", " // Uncomment to enable trace information:", " // parser.Trace shows what the parser is doing", " // parser.Trace = true;", " // scanner.Trace prints the tokens as they are parsed, one token per line", " // scanner.Trace = true;", " parser.scanner = scanner;", " try", " {", " " ++ def ++ " parse_tree = parser.Parse" ++ def ++ "();", " if (parse_tree != null)", " {", " Console.Out.WriteLine(\"Parse Successful!\");", " Console.Out.WriteLine(\"\");", " Console.Out.WriteLine(\"[Abstract Syntax]\");", " Console.Out.WriteLine(\"{0}\", PrettyPrinter.Show(parse_tree));", " Console.Out.WriteLine(\"\");", " Console.Out.WriteLine(\"[Linearized Tree]\");", " Console.Out.WriteLine(\"{0}\", PrettyPrinter.Print(parse_tree));", " }", " else", " {", " Console.Out.WriteLine(\"Parse NOT Successful!\");", " }", " }", " catch(Exception e)", " {", " Console.Out.WriteLine(\"Parse NOT Successful:\");", " Console.Out.WriteLine(e.Message);", " Console.Out.WriteLine(\"\");", " Console.Out.WriteLine(\"Stack Trace:\");", " Console.Out.WriteLine(e.StackTrace);", " }", " }", " else", " {", " Console.Out.WriteLine(\"You must specify a filename!\");", " }", " }", " }", "}" ] where def = head (allEntryPoints cf) filepathtonamespace :: FilePath -> Namespace filepathtonamespace file = take (length file - 3) (basename file) projectguid :: IO String projectguid = do maybeFilePath <- findDirectory guid <- maybe getBadGUID getGoodGUID maybeFilePath return guid where getBadGUID :: IO String getBadGUID = do putStrLn "-----------------------------------------------------------------------------" putStrLn "Could not find Visual Studio tool uuidgen.exe to generate project GUID!" putStrLn "You might want to put this tool in your PATH." putStrLn "-----------------------------------------------------------------------------" return "{00000000-0000-0000-0000-000000000000}" getGoodGUID :: FilePath -> IO String getGoodGUID filepath = do let filepath' = "\"" ++ filepath ++ "\"" (hIn, hOut, hErr, processHandle) <- runInteractiveCommand filepath' guid <- hGetLine hOut return ('{' : init guid ++ "}") findDirectory :: IO (Maybe FilePath) findDirectory = do -- This works with Visual Studio 2005. -- We will probably have to be modify this to include another environment variable name for Orcas. -- I doubt there is any need to support VS2003? (I doubt they have patched it up to have 2.0 support?) toolpath <- catchIOError (getEnv "VS80COMNTOOLS") (\_ -> return "C:\\Program Files\\Microsoft Visual Studio 8\\Common7\\Tools") exists <- doesDirectoryExist toolpath if exists then return (Just (toolpath ++ "\\uuidgen.exe")) -- this handles the case when the user was clever enough to add the directory to his/her PATH else findExecutable "uuidgen.exe" BNFC-2.6.0.3/src/formats/c-sharp/CFtoGPLEX.hs0000644000000000000000000002207112100475635016351 0ustar0000000000000000{- BNF Converter: C# GPLEX Generator Copyright (C) 2006 Author: Johan Broberg Modified from CFtoFlex 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the GPLEX file. Author : Johan Broberg (johan@pontemonti.com) License : GPL (GNU General Public License) Created : 23 November, 2006 Modified : 17 December, 2006 by Johan Broberg ************************************************************** -} module CFtoGPLEX (cf2gplex) where import CF import RegToGPLEX import Utils((+++), (++++)) import NamedVariables import Data.List import CSharpUtils --The environment must be returned for the parser to use. cf2gplex :: Namespace -> CF -> (String, SymEnv) cf2gplex namespace cf = (unlines [ prelude namespace, cMacros, prettyprinter $ (lexSymbols env) ++ (gplex namespace cf env'), "%%" ], env') where env = makeSymEnv (symbols cf ++ reservedWords cf) (0 :: Int) env' = env ++ (makeSymEnv (fst (unzip (tokenPragmas cf))) (length env)) -- GPPG doesn't seem to like tokens beginning with an underscore, so they (the underscores, nothing else) have been removed. makeSymEnv [] _ = [] makeSymEnv (s:symbs) n = (s, "SYMB_" ++ (show n)) : (makeSymEnv symbs (n+1)) prelude :: Namespace -> String prelude namespace = unlines [ "/* This GPLex file was machine-generated by the BNF converter */", "", "%namespace " ++ namespace, "", "%{", " /// ", " /// Buffer for escaped characters in strings.", " /// ", " private System.Text.StringBuilder strBuffer = new System.Text.StringBuilder();", "", " /// ", " /// Change to enable output - useful for debugging purposes", " /// ", " public bool Trace = false;", "", " /// ", " /// Culture-independent IFormatProvider for numbers. ", " /// This is just a \"wrapper\" for System.Globalization.NumberFormatInfo.InvariantInfo.", " /// ", " /// ", " /// This should be used when parsing numbers. Otherwise the parser might fail: ", " /// culture en-US uses a dot as decimal separator, while for example sv-SE uses a comma. ", " /// BNFC uses dot as decimal separator for Double values, so if your culture is sv-SE ", " /// the parse will fail if this InvariantInfo isn't used.", " /// ", " private static System.Globalization.NumberFormatInfo InvariantFormatInfo = System.Globalization.NumberFormatInfo.InvariantInfo;", "", " /// ", " /// Convenience method to create scanner AND initialize it correctly.", " /// As long as you don't want to enable trace output, this is all you ", " /// need to call and give to the parser to be able to parse.", " /// ", " public static Scanner CreateScanner(Stream stream)", " {", " Scanner scanner = new Scanner(stream);", " scanner.Begin();", " return scanner;", " }", "", " /// ", " /// Sets the scanner to the correct initial state (YYINITIAL). ", " /// You should call this method prior to calling parser.Parse().", " /// ", " public void Begin()", " {", " BEGIN(YYINITIAL);", " }", "", " /// ", " /// Convenience method to \"reset\" the buffer for escaped characters in strings.", " /// ", " private void BufferReset()", " {", " this.strBuffer = new System.Text.StringBuilder();", " }", "", "%}", "" ] --For now all categories are included. --Optimally only the ones that are used should be generated. cMacros :: String cMacros = unlines [ "alpha [a-zA-Z]", "alphaCapital [A-Z]", "alphaSmall [a-z]", "digit [0-9]", "ident [a-zA-Z0-9'_]", -- start states, must be defined one at a time "%s YYINITIAL", "%s COMMENT", "%s CHAR", "%s CHARESC", "%s CHAREND", "%s STRING", "%s ESCAPED", "%%" ] lexSymbols :: SymEnv -> [(String, String)] lexSymbols ss = map transSym ss where transSym (s,r) = ("\"" ++ s' ++ "\"" , "if(Trace) System.Console.Error.WriteLine(yytext); return (int)Tokens." ++ r ++ ";") where s' = escapeChars s gplex :: Namespace -> CF -> SymEnv -> [(String, String)] gplex namespace cf env = concat [ lexComments (comments cf), userDefTokens, ifC "String" strStates, ifC "Char" charStates, ifC "Double" [("{digit}+\".\"{digit}+(\"e\"(\\-)?{digit}+)?" , "if(Trace) System.Console.Error.WriteLine(yytext); yylval.double_ = Double.Parse(yytext, InvariantFormatInfo); return (int)Tokens.DOUBLE_;")], ifC "Integer" [("{digit}+" , "if(Trace) System.Console.Error.WriteLine(yytext); yylval.int_ = Int32.Parse(yytext, InvariantFormatInfo); return (int)Tokens.INTEGER_;")], ifC "Ident" [("{alpha}{ident}*" , "if(Trace) System.Console.Error.WriteLine(yytext); yylval.string_ = yytext; return (int)Tokens.IDENT_;")], [("[ \\t\\r\\n\\f]" , "/* ignore white space. */;")], [("." , "return (int)Tokens.error;")] ] where ifC cat s = if isUsedCat cf cat then s else [] userDefTokens = map tokenline (tokenPragmas cf) where tokenline (name, exp) = ("" ++ printRegGPLEX exp , action name) action n = "if(Trace) System.Console.Error.WriteLine(yytext); yylval." ++ varName (normCat n) ++ " = new " ++ identifier namespace n ++ "(yytext); return (int)Tokens." ++ sName n ++ ";" sName n = case lookup n env of Just x -> x Nothing -> n -- These handle escaped characters in Strings. strStates = [ ("\"\\\"\"" , "BEGIN(STRING);"), ("\\\\" , "BEGIN(ESCAPED);"), ("\\\"" , "yylval.string_ = this.strBuffer.ToString(); BufferReset(); BEGIN(YYINITIAL); return (int)Tokens.STRING_;"), ("." , "this.strBuffer.Append(yytext);"), ("n" , "this.strBuffer.Append(\"\\n\"); BEGIN(STRING);"), ("\\\"" , "this.strBuffer.Append(\"\\\"\"); BEGIN(STRING);"), ("\\\\" , "this.strBuffer.Append(\"\\\\\"); BEGIN(STRING);"), ("t" , "this.strBuffer.Append(\"\\t\"); BEGIN(STRING);"), ("." , "this.strBuffer.Append(yytext); BEGIN(STRING);") ] -- These handle escaped characters in Chars. charStates = [ ("\"'\"" , "BEGIN(CHAR);"), ("\\\\" , "BEGIN(CHARESC);"), ("[^']" , "BEGIN(CHAREND); yylval.char_ = yytext[0]; return (int)Tokens.CHAR_;"), ("n" , "BEGIN(CHAREND); yylval.char_ = '\\n'; return (int)Tokens.CHAR_;"), ("t" , "BEGIN(CHAREND); yylval.char_ = '\\t'; return (int)Tokens.CHAR_;"), ("." , "BEGIN(CHAREND); yylval.char_ = yytext[0]; return (int)Tokens.CHAR_;"), ("\"'\"" , "BEGIN(YYINITIAL);") ] lexComments :: ([(String, String)], [String]) -> [(String, String)] lexComments (m,s) = (map lexSingleComment s) ++ (concatMap lexMultiComment m) lexSingleComment :: String -> (String, String) lexSingleComment c = ("\"" ++ c ++ "\"[^\\n]*\\n" , "/* BNFC single-line comment */;") --There might be a possible bug here if a language includes 2 multi-line comments. --They could possibly start a comment with one character and end it with another. --However this seems rare. lexMultiComment :: (String, String) -> [(String, String)] lexMultiComment (b,e) = [ ("\"" ++ b ++ "\"" , "BEGIN(COMMENT);"), ("\"" ++ e ++ "\"" , "BEGIN(YYINITIAL);"), ("." , "/* BNFC multi-line comment */;"), ("[\\n]" , "/* BNFC multi-line comment */;") ] -- Used to print the lexer rules; makes sure that all rules are equally indented, to make the GPLEX file a little more readable. prettyprinter :: [(String, String)] -> String prettyprinter xs = unlines $ map prettyprinter' xs where padlength = 1 + (last $ sort $ map length $ map fst xs) prettyprinter' (x, y) = x ++ replicate (padlength - length x) ' ' ++ y BNFC-2.6.0.3/src/formats/c-sharp/CAbstoCSharpAbs.hs0000644000000000000000000002103512100475635017617 0ustar0000000000000000{- BNF Converter: C# Abstract Syntax Generator Copyright (C) 2006-2007 Author: Johan Broberg Modified from CFtoSTLAbs 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C# Abstract Syntax tree classes. It uses the Visitor design pattern. Author : Johan Broberg (johan@pontemonti.com) License : GPL (GNU General Public License) Created : 22 November, 2006 Modified : 21 January, 2007 by Johan Broberg ************************************************************** -} module CAbstoCSharpAbs (cabs2csharpabs) where import OOAbstract import CF import Utils((+++),(++++)) import NamedVariables import Data.List import Data.Char(toLower) import Data.Maybe import CSharpUtils --The result is one file (.cs) cabs2csharpabs :: Namespace -> CAbs -> Bool -> String cabs2csharpabs namespace cabs useWCF = unlinesInline [ "//C# Abstract Syntax Interface generated by the BNF Converter.", -- imports "using System;", if useWCF then "using System.Runtime.Serialization;" else "", "using System.Collections.Generic;", "namespace " ++ namespace ++ ".Absyn", "{", " #region Token Classes", prTokenBaseType useWCF, unlinesInlineMap (prToken namespace useWCF) (tokentypes cabs), " #endregion", " ", " #region Abstract Syntax Classes", unlinesInlineMap (prAbs namespace useWCF) abstractclasses, " ", unlinesInlineMap (prCon namespace useWCF) (flattenSignatures cabs), " ", " #region Lists", unlinesInlineMap (prList namespace) (listtypes cabs), " #endregion", " #endregion", "}" ] where -- an abstract class is a category which does not contain rules abstractclasses = [ (cat, (map fst cabsrules)) | (cat, cabsrules) <- signatures cabs, cat `notElem` (map fst cabsrules) ] -- auxiliaries prDataContract :: Bool -> [Cat] -> String prDataContract False _ = "" prDataContract True [] = " [DataContract]" prDataContract True funs = unlinesInline [ prDataContract True [], unlinesInline $ map prDataContract' funs ] where prDataContract' :: Cat -> String prDataContract' fun = " [KnownType(typeof(" ++ fun ++ "))]" prDataMember :: Bool -> String prDataMember False = "" prDataMember True = " [DataMember]" prTokenBaseType :: Bool -> String prTokenBaseType useWCF = unlinesInline [ prDataContract useWCF [], " public class TokenBaseType", " {", prDataMember useWCF, " private string str;", " ", " public TokenBaseType(string str)", " {", " this.str = str;", " }", " ", " public override string ToString()", " {", " return this.str;", " }", " }", " " ] prToken :: Namespace -> Bool -> Cat -> String prToken namespace useWCF name = unlinesInline [ prDataContract useWCF [], " public class " ++ name ++ " : " ++ identifier namespace "TokenBaseType", " {", " public " ++ name ++ "(string str) : base(str)", " {", " }", prAccept namespace name Nothing, prVisitor namespace [name], prEquals namespace name ["ToString()"], prHashCode namespace name ["ToString()"], " }" ] prAbs :: Namespace -> Bool -> (Cat, [Cat]) -> String prAbs namespace useWCF (cat, funs) = unlinesInline [ prDataContract useWCF funs, " public abstract class " ++ cat, " {", " public abstract R Accept(" ++ identifier namespace cat ++ ".Visitor v, A arg);", prVisitor namespace funs, " }" ] prVisitor :: Namespace -> [Cat] -> String prVisitor namespace funs = unlinesInline [ " ", " public interface Visitor", " {", unlinesInline (map prVisitFun funs), " }" ] where prVisitFun f = " R Visit(" ++ identifier namespace f ++ " p, A arg);" prCon :: Namespace -> Bool -> (Cat,CSharpAbsRule) -> String prCon namespace useWCF (c,(f,cs)) = unlinesInline [ prDataContract useWCF [], " public class " ++ f ++ ext, " {", -- Instance variables unlines [prInstVar typ var | (typ,_,var,_) <- cs], prConstructor namespace (f,cs), unlinesInline [prProperty typ var prop | (typ,_,var,prop) <- cs], prEquals namespace f propnames, prHashCode namespace f propnames, -- print Accept method, override keyword needed for classes inheriting an abstract class prAccept namespace c (if isAlsoCategory f c then Nothing else (Just " override")), -- if this label is also a category, we need to print the Visitor interface -- (if not, it was already printed in the abstract class) if isAlsoCategory f c then prVisitor namespace [c] else "", " }" ] where -- This handles the case where a LBNF label is the same as the category. ext = if isAlsoCategory f c then "" else " : " ++ identifier namespace (identCat c) propnames = [prop | (_, _, _, prop) <- cs] prInstVar typ var = unlinesInline [ " private " ++ identifier namespace (typename typ) +++ var ++ ";" ] prProperty typ var prop = unlinesInline [ " ", prDataMember useWCF, " public " ++ identifier namespace (typename typ) +++ prop, " {", " get", " {", " return this." ++ var ++ ";", " }", " set", " {", " this." ++ var ++ " = value;", " }", " }" ] -- Creates the Equals() methods prEquals :: Namespace -> Fun -> [String] -> String prEquals namespace c vars = unlinesInline [ " ", " public override bool Equals(Object obj)", " {", " if(this == obj)", " {", " return true;", " }", " if(obj is " ++ identifier namespace c ++ ")", " {", " return this.Equals((" ++ identifier namespace c ++ ")obj);", " }", " return base.Equals(obj);", " }", " ", " public bool Equals(" ++ identifier namespace c ++ " obj)", " {", " if(this == obj)", " {", " return true;", " }", " return " ++ prEqualsVars vars ++ ";", " }" ] where prEqualsVars [] = "true" prEqualsVars vs = concat $ intersperse " && " $ map equalVar vs equalVar v = "this." ++ v ++ ".Equals(obj." ++ v ++ ")" -- Creates the GetHashCode() method. prHashCode :: Namespace -> Fun -> [String] -> String prHashCode namespace c vars = unlinesInline [ " ", " public override int GetHashCode()", " {", " return " ++ prHashVars vars ++ ";", " }" ] where aPrime = 37 prHashVars [] = show aPrime prHashVars (v:vs) = prHashVars' (hashVar v) vs prHashVars' r [] = r prHashVars' r (v:vs) = prHashVars' (show aPrime ++ "*" ++ "(" ++ r ++ ")+" ++ hashVar v) vs hashVar var = "this." ++ var ++ ".GetHashCode()" prList :: Namespace -> (Cat,Bool) -> String prList namespace (c,_) = unlinesInline [ " public class " ++ c ++ " : List<" ++ identifier namespace (typename bas) ++ ">", " {", " }" ] where bas = drop 4 c -- drop List -- The standard Accept method for the Visitor pattern prAccept :: Namespace -> Cat -> Maybe String -> String prAccept namespace cat maybeOverride = unlinesInline [ " ", " public" ++ fromMaybe "" maybeOverride ++ " R Accept(" ++ identifier namespace cat ++ ".Visitor visitor, A arg)", " {", " return visitor.Visit(this, arg);", " }" ] -- The constructor assigns the parameters to the corresponding instance variables. prConstructor :: Namespace -> CSharpAbsRule -> String prConstructor namespace (f,cs) = unlinesInline [ " public " ++ f ++ "(" ++ conargs ++ ")", " {", unlinesInline [" " ++ c ++ " = " ++ p ++ ";" | (c,p) <- zip cvs pvs], " }" ] where cvs = [c | (_,_,c,_) <- cs] pvs = ["p" ++ show i | ((x,st,_,_),i) <- zip cs [1..]] conargs = concat $ intersperse ", " [identifier namespace (typename x) +++ v | ((x,_,_,_),v) <- zip cs pvs] BNFC-2.6.0.3/src/formats/c-sharp/CFtoCSharpPrinter.hs0000644000000000000000000003354312100475635020224 0ustar0000000000000000{- BNF Converter: C# Pretty Printer Generator Copyright (C) 2006 Author: Johan Broberg Modified from CFtoSTLPrinter 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C# Pretty Printer. It also generates the "show" method for printing an abstract syntax tree. Author : Johan Broberg (johan@pontemonti.com) License : GPL (GNU General Public License) Created : 26 November, 2006 Modified : 21 January, 2007 by Johan Broberg ************************************************************** -} module CFtoCSharpPrinter (cf2csharpprinter) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper, isSpace) import Data.Maybe import CSharpUtils --Produces .cs file cf2csharpprinter :: Namespace -> CF -> String cf2csharpprinter namespace cf = unlinesInline [ header namespace cf, " ", entrypoints namespace cf, " ", " #region (Internal) Print Methods", unlinesInlineMap (prData namespace user) groups, " #endregion", " ", " #region (Internal) Show Methods", unlinesInlineMap (shData namespace user) groups, " #endregion", " }", " #endregion", "}" ] where groups = fixCoercions (ruleGroupsInternals cf) user = [n | (n,_) <- tokenPragmas cf] header :: Namespace -> CF -> String header namespace cf = unlinesInline [ "/*** BNFC-Generated Pretty Printer and Abstract Syntax Viewer ***/", " ", -- imports "using System;", "using System.Text; // for StringBuilder", "using " ++ namespace ++ ".Absyn;", " ", "namespace " ++ namespace, "{", " #region Pretty-printer class", " public class PrettyPrinter", " {", " #region Misc rendering functions", " // You may wish to change these:", " private const int BUFFER_INITIAL_CAPACITY = 2000;", " private const string LEFT_PARENTHESIS = \"(\";", " private const string RIGHT_PARENTHESIS = \")\";", " private static System.Globalization.NumberFormatInfo InvariantFormatInfo = System.Globalization.NumberFormatInfo.InvariantInfo;", " ", " private static int _n_ = 0;", " private static StringBuilder buffer = new StringBuilder(BUFFER_INITIAL_CAPACITY);", " ", " //You may wish to change render", " private static void Render(String s)", " {", " if(s == \"{\")", " {", " buffer.Append(\"\\n\");", " Indent();", " buffer.Append(s);", " _n_ = _n_ + 2;", " buffer.Append(\"\\n\");", " Indent();", " }", " else if(s == \"(\" || s == \"[\")", " buffer.Append(s);", " else if(s == \")\" || s == \"]\")", " {", " Backup();", " buffer.Append(s);", " buffer.Append(\" \");", " }", " else if(s == \"}\")", " {", " _n_ = _n_ - 2;", " Backup();", " Backup();", " buffer.Append(s);", " buffer.Append(\"\\n\");", " Indent();", " }", " else if(s == \",\")", " {", " Backup();", " buffer.Append(s);", " buffer.Append(\" \");", " }", " else if(s == \";\")", " {", " Backup();", " buffer.Append(s);", " buffer.Append(\"\\n\");", " Indent();", " }", " else if(s == \"\") return;", " else", " {", " // Make sure escaped characters are printed properly!", " if(s.StartsWith(\"\\\"\") && s.EndsWith(\"\\\"\"))", " {", " buffer.Append('\"');", " StringBuilder sb = new StringBuilder(s);", " // Remove enclosing citation marks", " sb.Remove(0,1);", " sb.Remove(sb.Length-1,1);", " // Note: we have to replace backslashes first! (otherwise it will \"double-escape\" the other escapes)", " sb.Replace(\"\\\\\", \"\\\\\\\\\");", " sb.Replace(\"\\n\", \"\\\\n\");", " sb.Replace(\"\\t\", \"\\\\t\");", " sb.Replace(\"\\\"\", \"\\\\\\\"\");", " buffer.Append(sb.ToString());", " buffer.Append('\"');", " }", " else", " {", " buffer.Append(s);", " }", " buffer.Append(\" \");", " }", " }", " ", " private static void PrintInternal(int n, int _i_)", " {", " buffer.Append(n.ToString(InvariantFormatInfo));", " buffer.Append(' ');", " }", " ", " private static void PrintInternal(double d, int _i_)", " {", " buffer.Append(d.ToString(InvariantFormatInfo));", " buffer.Append(' ');", " }", " ", " private static void PrintInternal(string s, int _i_)", " {", " Render(s);", " }", " ", " private static void PrintInternal(char c, int _i_)", " {", " PrintQuoted(c);", " }", " ", unlinesInlineMap (prToken namespace) (tokenNames cf), " ", " private static void ShowInternal(int n)", " {", " Render(n.ToString(InvariantFormatInfo));", " }", " ", " private static void ShowInternal(double d)", " {", " Render(d.ToString(InvariantFormatInfo));", " }", " ", " private static void ShowInternal(char c)", " {", " PrintQuoted(c);", " }", " ", " private static void ShowInternal(string s)", " {", " PrintQuoted(s);", " }", " ", unlinesInlineMap (shToken namespace) (tokenNames cf), " ", " private static void PrintQuoted(string s)", " {", " Render(\"\\\"\" + s + \"\\\"\");", " }", " ", " private static void PrintQuoted(char c)", " {", " // Makes sure the character is escaped properly before printing it.", " string str = c.ToString();", " if(c == '\\n') str = \"\\\\n\";", " if(c == '\\t') str = \"\\\\t\";", " Render(\"'\" + str + \"'\");", " }", " ", " private static void Indent()", " {", " int n = _n_;", " while (n > 0)", " {", " buffer.Append(' ');", " n--;", " }", " }", " ", " private static void Backup()", " {", " if(buffer[buffer.Length - 1] == ' ')", " {", " buffer.Length = buffer.Length - 1;", " }", " }", " ", " private static void Trim()", " {", " while(buffer.Length > 0 && buffer[0] == ' ')", " buffer.Remove(0, 1); ", " while(buffer.Length > 0 && buffer[buffer.Length-1] == ' ')", " buffer.Remove(buffer.Length-1, 1);", " }", " ", " private static string GetAndReset()", " {", " Trim();", " string strReturn = buffer.ToString();", " Reset();", " return strReturn;", " }", " ", " private static void Reset()", " {", " buffer.Remove(0, buffer.Length);", " }", " #endregion" ] prToken :: Namespace -> Cat -> String prToken namespace token = unlinesInline [ " private static void PrintInternal(" ++ identifier namespace token ++ " token, int _i_)", " {", " buffer.Append('\\\"');", " buffer.Append(token.ToString());", " buffer.Append('\\\"');", " }" ] shToken :: Namespace -> Cat -> String shToken namespace token = unlinesInline [ " private static void ShowInternal(" ++ identifier namespace token ++ " token)", " {", " Render(token.ToString());", " }" ] entrypoints :: Namespace -> CF -> String entrypoints namespace cf = unlinesInline [ " #region Print Entry Points", unlinesInlineMap prEntryPoint (allCats cf), " #endregion", " ", " #region Show Entry Points", unlinesInlineMap shEntryPoint (allCats cf), " #endregion" ] where prEntryPoint cat | (normCat cat) == cat = unlinesInline [ " public static string Print(" ++ identifier namespace (identCat cat) ++ " cat)", " {", " PrintInternal(cat, 0);", " return GetAndReset();", " }" ] prEntryPoint _ = "" shEntryPoint cat | (normCat cat) == cat = unlinesInline [ " public static String Show(" ++ identifier namespace (identCat cat) ++ " cat)", " {", " ShowInternal(cat);", " return GetAndReset();", " }" ] shEntryPoint _ = "" prData :: Namespace -> [UserDef] -> (Cat, [Rule]) -> String prData namespace user (cat, rules) -- list | isList cat = unlinesInline [ " private static void PrintInternal(" ++ identifier namespace (identCat (normCat cat)) ++ " p, int _i_)", " {", (prList user cat rules), " }" ] -- not a list | otherwise = unlinesInline [ " private static void PrintInternal(" ++ identifier namespace (identCat (normCat cat)) ++ " p, int _i_)", " {", -- first rule starts with "if", the rest of them start with "else if". -- this isn't very pretty, but does the job and produces nice code. prRule namespace Nothing firstRule, unlinesInline $ map (prRule namespace (Just "else ")) otherRules, " }" ] where -- Removes the rules at the beginning of the list which won't be used by the prRule function. rules' = dropWhile (\r -> isCoercion (funRule r) || isDefinedRule (funRule r)) rules firstRule = head rules' otherRules = tail rules' prRule :: Namespace -> Maybe String -> Rule -> String prRule namespace maybeElse r@(Rule fun _c cats) | not (isCoercion fun || isDefinedRule fun) = unlinesInline [ " " ++ fromMaybe "" maybeElse ++ "if(p is " ++ identifier namespace fun ++ ")", " {", " " ++ identifier namespace fun +++ fnm ++ " = (" ++ identifier namespace fun ++ ")p;", " if(_i_ > " ++ (show p) ++ ") Render(LEFT_PARENTHESIS);", cats', " if(_i_ > " ++ (show p) ++ ") Render(RIGHT_PARENTHESIS);", " }" ] where p = precRule r cats' = case cats of [] -> "" _ -> unlinesInline $ map (prCat fnm) (zip (fixOnes (numProps [] cats)) (map getPrec cats)) fnm = '_' : map toLower fun getPrec (Right {}) = 0 getPrec (Left c) = precCat c prRule _nm _ _ = "" prList :: [UserDef] -> Cat -> [Rule] -> String prList user c rules = unlinesInline [ " for(int i=0; i < p.Count; i++)", " {", " PrintInternal(p[i], 0);", " if(i < p.Count - 1)", " {", " Render(\"" ++ escapeChars sep ++ "\");", " }", " else", " {", " Render(\"" ++ optsep ++ "\");", " }", " }" ] where et = typename (normCatOfList c) sep = getCons rules optsep = if hasOneFunc rules then "" else escapeChars sep prCat fnm (c, p) = case c of Right t -> " Render(\"" ++ escapeChars t ++ "\");" Left nt | "string" `isPrefixOf` nt -> " PrintQuoted(" ++ fnm ++ "." ++ nt ++ ");" | isInternalVar nt -> "" | otherwise -> " PrintInternal(" ++ fnm ++ "." ++ nt ++ ", " ++ show p ++ ");" --The following methods generate the Show function. shData :: Namespace -> [UserDef] -> (Cat, [Rule]) -> String shData namespace user (cat, rules) | isList cat = unlinesInline [ " private static void ShowInternal(" ++ identifier namespace (identCat (normCat cat)) ++ " p)", " {", (shList user cat rules), " }" ] | otherwise = unlinesInline [ " private static void ShowInternal(" ++ identifier namespace (identCat (normCat cat)) ++ " p)", " {", unlinesInline $ map (shRule namespace) rules, " }" ] shRule :: Namespace -> Rule -> String shRule namespace (Rule fun _c cats) | not (isCoercion fun || isDefinedRule fun) = unlinesInline [ " if(p is " ++ identifier namespace fun ++ ")", " {", " " ++ identifier namespace fun +++ fnm ++ " = (" ++ identifier namespace fun ++ ")p;", lparen, " Render(\"" ++ (escapeChars fun) ++ "\");", cats', rparen, " }" ] where cats' | allTerms cats = "" | otherwise = unlinesInline $ map (shCat fnm) (fixOnes (numProps [] cats)) lparen | allTerms cats = "" | otherwise = " Render(\"(\");" rparen | allTerms cats = "" | otherwise = " Render(\")\");" allTerms [] = True allTerms ((Left {}):_) = False allTerms (_:zs) = allTerms zs fnm = '_' : map toLower fun shRule _nm _ = "" shList :: [UserDef] -> Cat -> [Rule] -> String shList user c _rules = unlinesInline [ " for(int i=0; i < p.Count; i++)", " {", " ShowInternal(p[i]);", " if(i < p.Count - 1)", " Render(\",\");", " }" ] where et = typename (normCatOfList c) shCat fnm c = case c of Right {} -> "" Left nt | "list" `isPrefixOf` nt -> unlinesInline [ " Render(\"[\");", " ShowInternal(" ++ fnm ++ "." ++ nt ++ ");", " Render(\"]\");" ] | isInternalVar nt -> "" | otherwise -> " ShowInternal(" ++ fnm ++ "." ++ nt ++ ");" isInternalVar x = x == internalCat ++ "_" BNFC-2.6.0.3/src/formats/c-sharp/CFtoGPPG.hs0000644000000000000000000002262712100475635016236 0ustar0000000000000000{- BNF Converter: C# GPPG Generator Copyright (C) 2006 Author: Johan Broberg Modified from CFtoBisonSTL. 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the GPPG input file. Author : Johan Broberg (johan@pontemonti.com) License : GPL (GNU General Public License) Created : 24 November, 2006 Modified : 17 December, 2006 by Johan Broberg ************************************************************** -} module CFtoGPPG (cf2gppg) where import CF import Data.List (intersperse, isPrefixOf) import NamedVariables hiding (varName) import Data.Char (toLower,isUpper,isDigit) import Utils ((+++), (++++)) import TypeChecker import ErrM import OOAbstract hiding (basetypes) import CSharpUtils --This follows the basic structure of CFtoHappy. -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String --The environment comes from the CFtoGPLEX cf2gppg :: Namespace -> CF -> SymEnv -> String cf2gppg namespace cf env = unlines [ header namespace cf, union namespace (positionCats cf ++ allCats cf ++ tokentypes (cf2cabs cf)), tokens user env, declarations cf, "", specialToks cf, "", "%%", prRules (rulesForGPPG namespace cf env) ] where user = fst (unzip (tokenPragmas cf)) positionCats cf = filter (isPositionCat cf) $ fst (unzip (tokenPragmas cf)) header :: Namespace -> CF -> String header namespace cf = unlines [ "/* This GPPG file was machine-generated by BNFC */", "", "%namespace " ++ namespace, "%{", definedRules namespace cf, unlinesInline $ map (parseMethod namespace) (allCatsIdNorm cf ++ positionCats cf), "%}" ] definedRules :: Namespace -> CF -> String definedRules namespace cf = unlinesInline [ if null [ rule f xs e | FunDef f xs e <- pragmasOfCF cf ] then "" else error "Defined rules are not yet available in C# mode!" ] where ctx = buildContext cf list = LC (const "[]") (\t -> "List" ++ unBase t) where unBase (ListT t) = unBase t unBase (BaseT x) = normCat x rule f xs e = case checkDefinition' list ctx f xs e of Bad err -> error $ "Panic! This should have been caught already:\n" ++ err Ok (args,(e',t)) -> unlinesInline [ "Defined Rule goes here" ] --This generates a parser method for each entry point. parseMethod :: Namespace -> Cat -> String parseMethod namespace cat = unlinesInline [ " " ++ returntype +++ returnvar ++ " = null;", " public " ++ returntype ++ " Parse" ++ cat' ++ "()", " {", " if(this.Parse())", " {", " return " ++ returnvar ++ ";", " }", " else", " {", " throw new Exception(\"Could not parse input stream!\");", " }", " }", " " ] where cat' = identCat (normCat cat) returntype = identifier namespace cat' returnvar = resultName cat' --The union declaration is special to GPPG/GPLEX and gives the type of yylval. --For efficiency, we may want to only include used categories here. union :: Namespace -> [Cat] -> String union namespace cats = unlines $ filter (\x -> x /= "\n") [ "%union", "{", " public int int_;", " public char char_;", " public double double_;", " public string string_;", unlinesInline $ map catline cats, "}" ] where --This is a little weird because people can make [Exp2] etc. catline cat | (identCat cat /= cat) || (normCat cat == cat) = " public " ++ identifier namespace (identCat (normCat cat)) +++ (varName (normCat cat)) ++ ";" catline cat = "" --declares non-terminal types. declarations :: CF -> String declarations cf = unlinesInline $ map (typeNT cf) (positionCats cf ++ allCats cf) where --don't define internal rules typeNT cf nt | (isPositionCat cf nt || rulesForCat cf nt /= []) = "%type <" ++ (varName (normCat nt)) ++ "> " ++ (identCat nt) typeNT cf nt = "" --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user ts = concatMap (declTok user) ts where declTok u (s,r) = if elem s u then "%token<" ++ varName (normCat s) ++ "> " ++ r ++ " // " ++ s ++ "\n" else "%token " ++ r ++ " // " ++ s ++ "\n" specialToks :: CF -> String specialToks cf = unlinesInline [ ifC "String" "%token STRING_", ifC "Char" "%token CHAR_", ifC "Integer" "%token INTEGER_", ifC "Double" "%token DOUBLE_", ifC "Ident" "%token IDENT_" ] where ifC cat s = if isUsedCat cf cat then s else "" --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForGPPG :: Namespace -> CF -> SymEnv -> Rules rulesForGPPG namespace cf env = (map mkOne $ ruleGroups cf) ++ posRules where mkOne (cat,rules) = constructRule namespace cf env rules cat posRules = map mkPos $ positionCats cf mkPos cat = (cat, [(maybe cat id (lookup cat env), "$$ = new " ++ cat ++ "($1);")]) -- For every non-terminal, we construct a set of rules. constructRule :: Namespace -> CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule namespace cf env rules nt = (nt,[(p,(generateAction namespace nt (ruleName r) b m) +++ result) | r0 <- rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True,revSepListRule r0) else (False,r0), let (p,m) = generatePatterns cf env r b]) where ruleName r = case funRule r of ---- "(:)" -> identCat nt ---- "(:[])" -> identCat nt z -> z revs = reversibleCats cf eps = allEntryPoints cf isEntry nt = if elem nt eps then True else False result = if isEntry nt then (resultName (normCat (identCat nt))) ++ "= $$;" else "" -- Generates a string containing the semantic action. -- This was copied from CFtoCup15, with only a few small modifications generateAction :: Namespace -> NonTerminal -> Fun -> Bool -> [(MetaVar, Bool)] -> Action generateAction namespace nt f rev mbs | isNilFun f = "$$ = new " ++ identifier namespace c ++ "();" | isOneFun f = "$$ = new " ++ identifier namespace c ++ "(); $$.Add(" ++ p_1 ++ ");" | isConsFun f && not rev = "$$ = " ++ p_2 ++ "; " ++ p_2 ++ ".Insert(0, " ++ p_1 ++ ");" | isConsFun f && rev = "$$ = " ++ p_1 ++ "; " ++ p_1 ++ ".Add(" ++ p_2 ++ ");" | isCoercion f = "$$ = " ++ p_1 ++ ";" | isDefinedRule f = "$$ = " ++ f ++ "_" ++ "(" ++ concat (intersperse "," ms) ++ ");" | otherwise = "$$ = new " ++ identifier namespace c ++ "(" ++ concat (intersperse "," ms) ++ ");" where c = if isNilFun f || isOneFun f || isConsFun f then identCat (normCat nt) else f ms = map fst mbs p_1 = ms!!0 p_2 = ms!!1 -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: CF -> SymEnv -> Rule -> Bool -> (Pattern,[(MetaVar,Bool)]) generatePatterns cf env r revv = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> case lookup c env of -- This used to be x, but that didn't work if we had a symbol "String" in env, and tried to use a normal String - it would use the symbol... Just x | not (isPositionCat cf c) && c `notElem` (map fst basetypes) -> x _ -> typeName (identCat c) Right s -> case lookup s env of Just x -> x Nothing -> s metas its = [('$': show i,revert c) | (i,Left c) <- zip [1 :: Int ..] its] -- notice: reversibility with push_back vectors is the opposite -- of right-recursive lists! revert c = (head c == '[') && not (isConsFun (funRule r)) && notElem c revs revs = reversibleCats cf -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. prRules :: Rules -> String prRules [] = [] prRules ((nt, []):rs) = prRules rs --internal rule prRules ((nt,((p,a):ls)):rs) = (unwords [nt', ":" , p, "{ ", a, "}", "\n" ++ pr ls]) ++ ";\n" ++ prRules rs where nt' = identCat nt pr [] = [] pr ((p,a):ls) = (unlines [(concat $ intersperse " " [" |", p, "{ ", a , "}"])]) ++ pr ls --Some helper functions. resultName :: String -> String resultName s = "YY_RESULT_" ++ s ++ "_" --slightly stronger than the NamedVariable version. varName :: String -> String varName s = (map toLower (identCat s)) ++ "_" typeName :: String -> String typeName "Ident" = "IDENT_" typeName "String" = "STRING_" typeName "Char" = "CHAR_" typeName "Integer" = "INTEGER_" typeName "Double" = "DOUBLE_" typeName x = x BNFC-2.6.0.3/src/formats/c-sharp/CAbstoCSharpAbstractVisitSkeleton.hs0000644000000000000000000000674712100475635023416 0ustar0000000000000000{- BNF Converter: C# Abstract Visit Skeleton Generator Copyright (C) 2006 Author: Johan Broberg Modified from CAbstoCSharpVisitSkeleton 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates an Abstract Visit Skeleton for C#. This can be useful if you often make changes to your grammar and want to keep your own changes (not having to merge with the new visit skeleton each time), while still getting compile errors if your code is no longer correct. The generated file uses the Visitor design pattern. This could have been generated from within CAbstoVisitSkeleton, but that would have made it more difficult to actually use it (and the visit skeleton). Author : Johan Broberg (johan@pontemonti.com) License : GPL (GNU General Public License) Created : 19 December, 2006 Modified : 19 December, 2006 by Johan Broberg ************************************************************** -} module CAbstoCSharpAbstractVisitSkeleton (cabs2csharpAbstractVisitSkeleton) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import OOAbstract hiding (basetypes) import CSharpUtils import CAbstoCSharpAbs --Produces .cs file cabs2csharpAbstractVisitSkeleton :: Namespace -> CAbs -> String cabs2csharpAbstractVisitSkeleton namespace cabs = unlines [ "/*** BNFC-Generated Abstract Visitor Design Pattern Skeleton. ***/", "/* This implements the common visitor design pattern.", " Replace the R and A parameters with the desired return", " and context types.*/", "", "namespace " ++ namespace ++ ".VisitSkeleton", "{", " #region Classes", unlinesInlineMap (prCon namespace) (signatures cabs), " #endregion", " ", " #region Token types", unlinesInlineMap (prBasic namespace) (tokentypes cabs), " #endregion", "}" ] prBasic namespace c = unlinesInline [ " public abstract class Abstract" ++ c ++ "Visitor : " ++ identifier namespace c ++ ".Visitor", " {", " public abstract R Visit(" ++ identifier namespace (typename c) +++ varname c ++ ", A arg);", " }" ] prCon :: Namespace -> (Cat, [CAbsRule]) -> String prCon namespace (c,fs) = unlinesInline [ " public abstract class Abstract" ++ c ++ "Visitor : " ++ identifier namespace c ++ ".Visitor", " {", unlinesInlineMap (prVisit namespace) fs, " }" ] prVisit :: Namespace -> (Fun, [(Cat, Bool, String)]) -> String prVisit namespace (f,cs) = unlinesInline [ " public abstract R Visit(" ++ identifier namespace f +++ varname f ++ ", A arg);" ] BNFC-2.6.0.3/src/formats/c-sharp/CAbstoCSharpVisitSkeleton.hs0000644000000000000000000001024512100475635021716 0ustar0000000000000000{- BNF Converter: C# Visit Skeleton Generator Copyright (C) 2006 Author: Johan Broberg 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C# Visit Skeleton. The generated file uses the Visitor design pattern. Author : Johan Broberg (johan@pontemonti.com) License : GPL (GNU General Public License) Created : 30 November, 2006 Modified : 21 January, 2007 by Johan Broberg ************************************************************** -} module CAbstoCSharpVisitSkeleton (cabs2csharpvisitskeleton) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import OOAbstract hiding (basetypes) import CSharpUtils import CAbstoCSharpAbs --Produces .cs file cabs2csharpvisitskeleton :: Namespace -> CAbs -> String cabs2csharpvisitskeleton namespace cabs = unlines [ "/*** BNFC-Generated Visitor Design Pattern Skeleton. ***/", "/* This implements the common visitor design pattern. To make sure that", " compile errors occur when code in the Visitor don't match the abstract", " syntaxt, the \"abstract visit skeleton\" is used.", " ", " Replace the R and A parameters with the desired return", " and context types.*/", "", "namespace " ++ namespace ++ ".VisitSkeleton", "{", " #region Classes", unlinesInlineMap (prCon namespace) (signatures cabs), " #endregion", " ", " #region Token types", unlinesInlineMap (prBasic namespace) (tokentypes cabs), " #endregion", "}" ] prBasic namespace c = unlinesInline [ " public class " ++ c ++ "Visitor : Abstract" ++ c ++ "Visitor", " {", " public override R Visit(" ++ identifier namespace (typename c) +++ varname c ++ ", A arg)", " {", " /* Code for " ++ c ++ " Goes Here */", " return default(R);", " }", " }" ] prCon :: Namespace -> (Cat, [CAbsRule]) -> String prCon namespace (c,fs) = unlinesInline [ " public class " ++ c ++ "Visitor : Abstract" ++ c ++ "Visitor", " {", unlinesInlineMap (prVisit namespace) (map cabsrule2csharpabsrule fs), " }" ] prVisit :: Namespace -> CSharpAbsRule -> String prVisit namespace (f,cs) = unlinesInline [ " public override R Visit(" ++ identifier namespace f +++ varname f ++ ", A arg)", " {", " /* Code For " ++ f ++ " Goes Here */", unlinesInline $ map (prVisitArg namespace (varname f)) cs, " return default(R);", " }" ] prVisitArg :: Namespace -> String -> (Cat, Bool, VariableName, PropertyName) -> String prVisitArg namespace vname (cat, isPt, var, prop) | cat `elem` (map fst basetypes) = " // " ++ vname ++ "." ++ prop -- var /= "list_" is a dummy fix to make sure that a category named "List" doesn't get interpreted as a List. -- this isn't very good though, and should be fixed somehow. | "list" `isPrefixOf` var && var /= "list_" = listAccept | otherwise = " " ++ vname ++ "." ++ prop ++ ".Accept(new " ++ cat ++ "Visitor(), arg);" where listtype = typename (drop 4 cat) listAccept = unlinesInline [ " foreach(" ++ identifier namespace listtype ++ " x in " ++ vname ++ "." ++ prop ++ ")", " {", if listtype `notElem` (map snd basetypes) then " x.Accept(new " ++ listtype ++ "Visitor(), arg);" else " // x", " }" ] BNFC-2.6.0.3/src/formats/c-sharp/CSharpUtils.hs0000644000000000000000000001327212100475635017122 0ustar0000000000000000{- BNF Converter: Utility Functions for C# Copyright (C) 2006 Author: Johan Broberg 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module provides utility functions for the C# format. Author : Johan Broberg (johan@pontemonti.com) License : GPL (GNU General Public License) Created : 23 November, 2006 Modified : 21 January, 2007 by Johan Broberg ************************************************************** -} module CSharpUtils where import CF import Control.Monad.ST -- Control.Monad.State import Data.Char (toLower) import Data.Maybe import Data.List import OOAbstract hiding (basetypes) type Namespace = String --The visit-function name of a basic type visitFunName :: String -> String visitFunName v = if "integer_" `isPrefixOf` v then "Integer" else if "char_" `isPrefixOf` v then "Char" else if "string_" `isPrefixOf` v then "String" else if "double_" `isPrefixOf` v then "Double" else if "ident_" `isPrefixOf` v then "Ident" else "Ident" --User-defined type isUserDefined :: String -> Bool isUserDefined v = v `notElem` (map classVar (map fst basetypes)) basetypes = [ ("Integer","int"), ("Char", "char"), ("Double", "double"), ("String", "string"), ("Ident", "string") ] typename :: String -> String typename name | name == "Char" = "char" | name == "Double" = "double" | name == "Ident" = "string" | name == "Integer" = "int" | name == "String" = "string" | otherwise = name -- Creates a variable name. -- To make sure that no reserved keyword is generated, an underscore is added at the end. Not very pretty, but effective. varname :: String -> String varname name = (map toLower name) ++ "_" -- Given a variable name (in an abstract syntax class), returns ".ToString()" if the name doesn't match one of the basetypes. toString :: String -> String toString v = if isUserDefined v then ".ToString()" else "" -- Prepends namespace ".Absyn." to typ unless it is one of the basetypes identifier :: Namespace -> String -> String identifier namespace typ | typ `elem` (map snd basetypes) = typ | otherwise = namespace ++ ".Absyn." ++ typ -- Removes empty lines, and removes the line-break at the end. -- This can be useful if you want to use unlines "inside" unlines and don't want a whole lot of "useless" line-breaks. unlinesInline :: [String] -> String unlinesInline xs = concat $ intersperse "\n" $ filter (\x -> x /= "") xs unlinesInlineMap :: (a -> String) -> [a] -> String unlinesInlineMap fun xs = unlinesInline $ intersperse " " $ filter (\x -> x /= "") $ map fun xs --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) escapeChars (x:xs) = x : (escapeChars xs) isAlsoCategory :: Fun -> Cat -> Bool isAlsoCategory f c = f == c flattenSignatures :: CAbs -> [(Cat, CSharpAbsRule)] flattenSignatures cabs = [(c,r) | (c,rs) <- signatures cabs, r <- map cabsrule2csharpabsrule rs] type VariableName = String type PropertyName = String -- Just like CAbsRule in OOAbstract, except this also has PropertyName. -- (valcat,(constr,args)), True = is class (not basic), class variable stored type CSharpAbsRule = (Fun,[(Cat,Bool,VariableName,PropertyName)]) cabsrule2csharpabsrule :: CAbsRule -> CSharpAbsRule cabsrule2csharpabsrule (f, cabsrule) = (f, addPropertyNames cabsrule) -- This generates names for properties. It's done the same way as generation of variable names in OOAbstract->cf2cabs -- A property name uses the same casing as its category, but has an underscore at the end addPropertyNames :: [(Cat, Bool, String)] -> [(Cat, Bool, VariableName, PropertyName)] addPropertyNames cs = [(c,b,v,p) | ((c,b,v),p) <- zip cs (properties [] (map propertyName [c | (c,_,_) <- cs]))] --- creating new names is quadratic, but parameter lists are short --- this should conform with Michael's naming where properties seen vv = case vv of [] -> vv v:vs -> case length (filter (==v) seen) of 0 | elem v vs -> (v ++ "1"): properties (v:seen) vs 0 -> v : properties (v:seen) vs n -> (v ++ show (n+1)) : properties (v:seen) vs propertyName :: Cat -> PropertyName propertyName c = c ++ "_" -- Given a rule's definition, it goes through and nicely the properties by type. -- Does the same thing as numVars in NamedVariables, except the varName part numProps :: [(String, Int)] -> [Either String b] -> [Either String b] numProps _env [] = [] numProps env ((Right f) : fs) = (Right f) : (numProps env fs) numProps env ((Left f) : fs) = case lookup f' env of Nothing -> (Left f') : (numProps ((f',1):env) fs) Just n -> (Left $ f' ++ (show $ n + 1)) : (numProps ((f',n+1):env) fs) where f' = propertyName (normCat (identCat f)) BNFC-2.6.0.3/src/formats/java/0000755000000000000000000000000012100475635013744 5ustar0000000000000000BNFC-2.6.0.3/src/formats/java/CFtoCup.hs0000644000000000000000000002341112100475635015604 0ustar0000000000000000{- BNF Converter: Java Cup Generator Copyright (C) 2004 Author: Markus Forsberg, Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the CUP input file. It follows the same basic structure of CFtoHappy. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 26 April, 2003 Modified : 2 September, 2003 ************************************************************** -} module CFtoCup ( cf2Cup ) where import CF import Data.List (intersperse, isPrefixOf) import Data.Char (isUpper) import NamedVariables import TypeChecker -- We need to (re-)typecheck to figure out list instances in -- defined rules. import ErrM import Utils ( (+++) ) -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String --The environment comes from the CFtoJLex cf2Cup :: String -> String -> CF -> SymEnv -> String cf2Cup packageBase packageAbsyn cf env = unlines [ header, declarations packageAbsyn (allCats cf), tokens env, specialToks cf, specialRules cf, prEntryPoint cf, prRules (rulesForCup packageAbsyn cf env) ] where header :: String header = unlines ["// -*- Java -*- This Cup file was machine-generated by BNFC", "package" +++ packageBase ++ ";", "", "import java_cup.runtime.*;", "import" +++ packageAbsyn ++ ".*;", "", "parser code {:", parseMethod packageAbsyn (firstEntry cf), definedRules packageAbsyn cf, -- unlines $ map (parseMethod packageAbsyn) (allEntryPoints cf), "public void syntax_error(Symbol cur_token)", "{", "\treport_error(\"Syntax Error, trying to recover and continue parse...\", cur_token);", "}", "", "public void unrecovered_syntax_error(Symbol cur_token) throws java.lang.Exception", "{", "\tthrow new Exception(\"Unrecoverable Syntax Error\");", "}", "", ":}" ] definedRules :: String -> CF -> String definedRules packageAbsyn cf = unlines [ rule f xs e | FunDef f xs e <- pragmasOfCF cf ] where ctx = buildContext cf list = LC (const "null") (\t -> "List" ++ unBase t) where unBase (ListT t) = unBase t unBase (BaseT x) = normCat x rule f xs e = case checkDefinition' list ctx f xs e of Bad err -> error $ "Panic! This should have been caught already:\n" ++ err Ok (args,(e',t)) -> unlines [ "public " ++ javaType t ++ " " ++ f ++ "_ (" ++ concat (intersperse ", " $ map javaArg args) ++ ") {" , " return " ++ javaExp e' ++ ";" , "}" ] where javaType :: Base -> String javaType (ListT (BaseT x)) = packageAbsyn ++ ".List" ++ normCat x javaType (ListT t) = javaType t javaType (BaseT x) | isToken x ctx = "String" | otherwise = packageAbsyn ++ "." ++ normCat x javaArg :: (String, Base) -> String javaArg (x,t) = javaType t ++ " " ++ x ++ "_" javaExp :: Exp -> String javaExp (App "null" []) = "null" javaExp (App x []) | elem x xs = x ++ "_" -- argument javaExp (App t [e]) | isToken t ctx = call ("new String") [e] javaExp (App x es) | isUpper (head x) = call ("new " ++ packageAbsyn ++ "." ++ x) es | otherwise = call (x ++ "_") es javaExp (LitInt n) = "new Integer(" ++ show n ++ ")" javaExp (LitDouble x) = "new Double(" ++ show x ++ ")" javaExp (LitChar c) = "new Character(" ++ show c ++ ")" javaExp (LitString s) = "new String(" ++ show s ++ ")" call x es = x ++ "(" ++ concat (intersperse ", " $ map javaExp es) ++ ")" -- peteg: FIXME JavaCUP can only cope with one entry point AFAIK. prEntryPoint :: CF -> String prEntryPoint cf = unlines ["", "start with " ++ firstEntry cf ++ ";", ""] -- [ep] -> unlines ["", "start with " ++ ep ++ ";", ""] -- eps -> error $ "FIXME multiple entry points." ++ show eps --This generates a parser method for each entry point. parseMethod :: String -> Cat -> String parseMethod packageAbsyn cat = if normCat cat /= cat then "" else unlines [ " public" +++ packageAbsyn ++ "." ++ cat' +++ "p" ++ cat' ++ "()" ++ " throws Exception", " {", "\tSymbol res = parse();", "\treturn (" ++ packageAbsyn ++ "." ++ cat' ++ ") res.value;", " }" ] where cat' = identCat (normCat cat) --non-terminal types declarations :: String -> [NonTerminal] -> String declarations packageAbsyn ns = unlines (map (typeNT packageAbsyn) ns) where typeNT _nm nt = "nonterminal" +++ packageAbsyn ++ "." ++ identCat (normCat nt) +++ identCat nt ++ ";" --terminal types tokens :: SymEnv -> String tokens ts = unlines (map declTok ts) where declTok (s,r) = "terminal" +++ r ++ "; // " ++ s specialToks :: CF -> String specialToks cf = unlines [ ifC "String" "terminal String _STRING_;", ifC "Char" "terminal Character _CHAR_;", ifC "Integer" "terminal Integer _INTEGER_;", ifC "Double" "terminal Double _DOUBLE_;", ifC "Ident" "terminal String _IDENT_;" ] where ifC cat s = if isUsedCat cf cat then s else "" -- This handles user defined tokens -- FIXME specialRules:: CF -> String specialRules cf = unlines ["terminal String " ++ name ++ ";" | (name, _) <- tokenPragmas cf] --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForCup :: String -> CF -> SymEnv -> Rules rulesForCup packageAbsyn cf env = map mkOne $ ruleGroups cf where mkOne (cat,rules) = constructRule packageAbsyn cf env rules cat -- For every non-terminal, we construct a set of rules. A rule is a sequence of -- terminals and non-terminals, and an action to be performed. constructRule :: String -> CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule packageAbsyn cf env rules nt = (nt, [(p,generateAction packageAbsyn nt (funRule r) (revM b m)) | r0 <- rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True, revSepListRule r0) else (False, r0) (p,m) = generatePatterns cf env r]) where --this basically reverses revSepListRule for the parameters revM False m = m revM True (h:c:t) = (t ++ [c] ++ [h]) revs = reversibleCats cf -- Generates a string containing the semantic action. generateAction :: String -> NonTerminal -> Fun -> [MetaVar] -> Action generateAction packageAbsyn nt f ms = if isNilFun f then "RESULT = null;" else if isOneFun f then "RESULT = new " ++ packageAbsyn ++ "." ++ identCat (normCat nt) ++ (concat $ ["("] ++ ms ++ [",null);"]) else (unwords $ (if isCoercion f then [unwords revLists, "RESULT = "] else if isDefinedRule f then [unwords revLists, "RESULT = parser." ++ f ++ "_"] else [unwords revLists, "RESULT = new " ++ packageAbsyn ++ "." ++ f'] )) ++ (concat $ ["("] ++ ms'' ++ [");"]) where f' = if isConsFun f then identCat (normCat nt) else f (revLists, ms') = revMs [] [] ms ms'' = reverse ms' revMs ls ns [] = (ls,ns) revMs ls ns (m:ms) = if "list_" `isPrefixOf` m then revMs (("if (" ++ m' ++ " != null) " ++ m' ++ " = " ++ m' ++ ".reverse(); ") : ls) (m' : ns) ms else revMs ls (m:ns) ms where m' = drop 5 m --remove the list marker -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: CF -> SymEnv -> Rule -> (Pattern,[MetaVar]) generatePatterns cf env r = case rhsRule r of [] -> (" /* empty */ ",[]) its -> (mkIt env 1 its, metas its) where mkIt _env _n [] = [] mkIt env n (i:is) = case i of Left c -> c' ++ ":p_" ++ (show (n :: Int)) +++ (mkIt env (n+1) is) where c' = case c of "Ident" -> "_IDENT_" "Integer" -> "_INTEGER_" "Char" -> "_CHAR_" "Double" -> "_DOUBLE_" "String" -> "_STRING_" _ -> identCat c Right s -> case (lookup s env) of (Just x) -> x +++ (mkIt env (n+1) is) (Nothing) -> (mkIt env n is) metas its = intersperse "," [revIf c ("p_" ++ (show i)) | (i,Left c) <- zip [1 :: Int ..] its] --This is slightly messy, but it marks lists for reversal. revIf c m = if (not (isConsFun (funRule r)) && elem c revs) then "list_" ++ m -- ("(reverse " ++ m ++ ")") --not yet! else m -- no reversal in the left-recursive Cons rule itself revs = reversibleCats cf -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. prRules :: Rules -> String prRules [] = [] prRules ((nt, []):rs) = prRules rs --internal rule prRules ((nt,((p,a):ls)):rs) = (unwords [nt', "::=", p, "{:", a, ":}", "\n" ++ pr ls]) ++ ";\n" ++ prRules rs where nt' = identCat nt pr [] = [] pr ((p,a):ls) = (unlines [(concat $ intersperse " " [" |", p, "{:", a , ":}"])]) ++ pr ls BNFC-2.6.0.3/src/formats/java/CFtoJavaSkeleton.hs0000644000000000000000000000670212100475635017447 0ustar0000000000000000{- ************************************************************** BNF Converter Module Description : This module generates the Skeleton Function using Appel's method, not the Visitor Pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 29 April, 2003 Modified : 2 September, 2003 ************************************************************** -} module CFtoJavaSkeleton (cf2JavaSkeleton) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower) cf2JavaSkeleton :: String -> String -> CF -> String cf2JavaSkeleton packageBase packageAbsyn cf = unlines [ header, unlines (map (prData packageAbsyn) groups), footer] where groups = (fixCoercions (ruleGroups cf)) header = unlines [ "package" +++ packageBase ++ ";", "import" +++ packageAbsyn ++ ".*;", "/*** BNFC-Generated Skeleton function. ***/", "/* You will probably want to save this in a new file.", " Then do two search-and-replaces.", " First replace \"skel\" with a real funciton name.", " Then replace Object with a real return type. */", "", "public class Skeleton", "{" ] footer = unlines [ --later only include used categories " public static Object skel(Integer i) { return null; }", " public static Object skel(Double d) { return null; }", " public static Object skel(String s) { return null; }", "}" ] --Traverses a category based on its type. prData :: String -> (Cat, [Rule]) -> String prData packageAbsyn (cat, rules) = if isList cat then unlines [ " public static Object skel(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo)", " {", prList cat rules, " }" ] else unlines --not a list [ " public static Object skel(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo)", " {", unlines (map (prRule packageAbsyn) rules), " return null;", " }" ] --traverses a standard rule prRule :: String -> Rule -> String prRule packageAbsyn (Rule fun c cats) | not (isCoercion fun) = unlines [ " if (foo instanceof" +++ packageAbsyn ++ "." ++ fun ++ ")", " {", " " ++ packageAbsyn ++ "." ++ fun +++ fnm +++ "= (" ++ packageAbsyn ++ "." ++ fun ++ ") foo;", "", " /* Code For " ++ fun ++ " Goes Here */", "", cats', " return null;", " }" ] where cats' = if allTerms cats then "" else (unlines (map (prCat fnm) (fixOnes (numVars [] cats)))) allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs fnm = map toLower fun prRule nm _ = "" --This traverses list rules. prList :: Cat -> [Rule] -> String prList c rules = unlines [ " if (foo == null)", " {", " /* Optional End of List Code Goes Here */", " return null;", " }", " else", " {", " /* Optional List Member Code Goes Here */", " skel(foo." ++ c' ++ "_);", " skel(foo." ++ c'' ++ "_);", " return null;", " }" ] where c' = map toLower (identCat (normCatOfList c)) c'' = map toLower (identCat c) --This traverses a class's instance variables. prCat fnm c = case c of (Right t) -> "" (Left nt) -> " skel(" ++ fnm ++ "." ++ nt ++ ");" BNFC-2.6.0.3/src/formats/java/JavaTop.hs0000644000000000000000000002547712100475635015663 0ustar0000000000000000{- BNF Converter: Java Top File Copyright (C) 2004 Author: Markus Forsberg, Peter Gammie, Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} ------------------------------------------------------------------- -- | -- Module : JavaTop -- Copyright : (C)opyright 2003, {markus, aarne, pellauer, peteg} at cs dot chalmers dot se -- License : GPL (see COPYING for details) -- -- Maintainer : {markus, aarne} at cs dot chalmers dot se -- Stability : alpha -- Portability : Haskell98 -- -- Top-level for the Java back end. -- -- > $Id: JavaTop.hs,v 1.10 2005/09/21 13:06:10 bringert Exp $ ------------------------------------------------------------------- module JavaTop ( makeJava ) where ------------------------------------------------------------------- -- Dependencies. ------------------------------------------------------------------- import System.Directory ( createDirectory ) import System.IO.Error ( tryIOError, isAlreadyExistsError ) import System.Exit ( exitFailure ) import Utils import CF import CFtoCup ( cf2Cup ) import CFtoJLex import CFtoJavaAbs ( cf2JavaAbs ) import CFtoJavaPrinter import CFtoJavaSkeleton import CFtoVisitSkel import CFtoLatex import Data.Char import Data.List(intersperse) ------------------------------------------------------------------- -- | Build the Java output. -- FIXME: get everything to put the files in the right places. -- Adapt Makefile to do the business. ------------------------------------------------------------------- makeJava :: Bool -> String -> CF -> IO () makeJava = mkFiles mkFiles :: Bool -> String -> CF -> IO () mkFiles make name cf = do -- Create the package directories if necessary. let packageBase = name packageAbsyn = packageBase ++ "." ++ "Absyn" dirBase = pkgToDir packageBase dirAbsyn = pkgToDir packageAbsyn chkExists dirBase chkExists dirAbsyn let absynFiles = remDups $ cf2JavaAbs packageBase packageAbsyn cf absynBaseNames = map fst absynFiles absynFileNames = map (dirAbsyn ++) absynBaseNames let writeAbsyn (filename, contents) = writeFileRep (dirAbsyn ++ filename ++ ".java") contents mapM writeAbsyn absynFiles writeFileRep (dirBase ++ "PrettyPrinter.java") $ cf2JavaPrinter packageBase packageAbsyn cf writeFileRep (dirBase ++ "Skeleton.java") $ cf2JavaSkeleton packageBase packageAbsyn cf writeFileRep (dirBase ++ "Visitable.java") $ prVisitable packageBase let user = fst $ unzip $ tokenPragmas cf -- FIXME better var name writeFileRep (dirBase ++ "Visitor.java") $ prVisitor packageBase packageAbsyn absynBaseNames user writeFileRep (dirBase ++ "VisitSkel.java") $ cf2VisitSkel packageBase packageAbsyn cf writeFileRep (dirBase ++ "Test.java") $ javaTest packageBase packageAbsyn cf let (lex, env) = cf2jlex packageBase packageAbsyn cf writeFileRep (dirBase ++ "Yylex") lex putStrLn " (Tested with JLex 1.2.6.)" writeFileRep (dirBase ++ name ++ ".cup") $ cf2Cup packageBase packageAbsyn cf env -- FIXME: put in a doc directory? putStrLn $ " (Parser created for category " ++ firstEntry cf ++ ")" putStrLn " (Tested with CUP 0.10k)" writeFileRep (name ++ ".tex") $ cfToLatex name cf if make then writeFileRep "Makefile" $ makefile name dirBase dirAbsyn absynFileNames else return () where remDups [] = [] remDups ((a,b):as) = case lookup a as of Just {} -> remDups as Nothing -> (a, b) : (remDups as) pkgToDir :: String -> FilePath pkgToDir p = [ if c == '.' then '/' else c | c <- p] ++ "/" chkExists :: FilePath -> IO () chkExists dir = do eErr <- tryIOError $ createDirectory dir case eErr of Left ioerr -> if isAlreadyExistsError ioerr then return () else fail $ show ioerr Right () -> putStrLn $ "Created directory: " ++ dir -- FIXME get filenames right. -- FIXME It's almost certainly better to just feed all the Java source -- files to javac in one go. -- Replace with an ANT script? makefile :: String -> FilePath -> FilePath -> [String] -> String makefile name dirBase dirAbsyn absynFileNames = unlines [ "JAVAC = javac", "JAVAC_FLAGS = -sourcepath .", "", "JAVA = java", "", "CUP = java_cup.Main", "CUPFLAGS = -nopositions -expect 100", "", "JLEX = JLex.Main", "", "LATEX = latex", "DVIPS = dvips", "", "all: test " ++ name ++ ".ps", "", "test: absyn " ++ unwords (map (dirBase ++) ["Visitor.class", "Visitable.class", "Test.class"]), "", ".PHONE: absyn", "", "absyn: " ++ absynJavaClass, "", "%.class: " ++ "%.java", "\t${JAVAC} ${JAVAC_FLAGS} $*.java", "", dirBase ++ "Visitable.class: " ++ dirBase ++ "Visitable.java", "\t${JAVAC} ${JAVAC_FLAGS} " ++ dirBase ++ "Visitable.java", "", dirBase ++ "Visitor.class: " ++ dirBase ++ "Visitor.java", "\t${JAVAC} ${JAVAC_FLAGS} " ++ dirBase ++ "Visitor.java", "", dirBase ++ "Yylex.java: " ++ dirBase ++ "Yylex", "\t${JAVA} ${JLEX} " ++ dirBase ++ "Yylex", "", -- FIXME dirBase ++ "sym.java" ++ " " ++ dirBase ++ "parser.java: " ++ dirBase ++ name ++ ".cup", "\t${JAVA} ${CUP} ${CUPFLAGS} " ++ dirBase ++ name ++ ".cup ; mv sym.java parser.java " ++ dirBase, "", dirBase ++ "Yylex.class: " ++ dirBase ++ "Yylex.java " ++ dirBase ++ "sym.java", "\t${JAVAC} ${JAVAC_FLAGS} " ++ dirBase ++ "Yylex.java", "", dirBase ++ "Test.class: " ++ unwords (map (dirBase ++) ["Test.java", "PrettyPrinter.class", "Yylex.class", "parser.class", "sym.class"]), "\t${JAVAC} ${JAVAC_FLAGS} " ++ dirBase ++ "Test.java", "", "" ++ name ++ ".dvi: " ++ name ++ ".tex", "\t${LATEX} " ++ name ++ ".tex", "", "" ++ name ++ ".ps: " ++ name ++ ".dvi", "\t${DVIPS} " ++ name ++ ".dvi -o " ++ name ++ ".ps", -- FIXME "", "clean:", "\t rm -f " ++ absynJavaClass, "\t rm -f " ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps " ++ " *.class Makefile", "", "distclean:", "\t rm -f " ++ absynJavaSrc ++ " " ++ absynJavaClass, "\t rmdir " ++ dirAbsyn, "\t rm -f " ++ name ++ ".tex " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps ", "\t rm -f " ++ unwords (map (dirBase ++) ["Yylex", name ++ ".cup", "Yylex.java", "sym.java", "parser.java", "Visitor.java", "Visitable.java", "VisitSkel.java", "PrettyPrinter.java", "Skeleton.java", "Test.java", "*.class"]), "\t rmdir " ++ dirBase, "\t rm -f Makefile", "" ] where absynJavaSrc = unwords (map (++ ".java") absynFileNames) absynJavaClass = unwords (map (++ ".class") absynFileNames) prVisitable :: String -> String prVisitable packageBase = unlines [ "package" +++ packageBase ++ ";\n", "public interface Visitable", "{", " public void accept(" ++ packageBase ++ ".Visitor v);", "}" ] prVisitor :: String -> String -> [String] -> [String]-> String prVisitor packageBase packageAbsyn funs user = unlines [ "package" +++ packageBase ++ ";\n", "public interface Visitor", "{", concatMap prVisitFun funs, concatMap prUser user, footer ] where prUser u = " public void visit" ++ u' ++ "(String p);\n" where u' = ((toUpper (head u)) : (map toLower (tail u))) --this is a hack to fix a potential capitalization problem. footer = unlines [ --later only include used categories " public void visitIdent(String i);", " public void visitInteger(Integer i);", " public void visitDouble(Double d);", " public void visitChar(Character c);", " public void visitString(String s);", "}" ] prVisitFun f = " public void visit" ++ f ++ "(" ++ packageAbsyn ++ "." ++ f ++ " p);\n" javaTest :: String -> String -> CF -> String javaTest packageBase packageAbsyn cf = unlines [ "package" +++ packageBase ++ ";", "import java_cup.runtime.*;", "import" +++ packageBase ++ ".*;", "import" +++ packageAbsyn ++ ".*;", "import java.io.*;", "", "public class Test", "{", " public static void main(String args[]) throws Exception", " {", " Yylex l = null;", " parser p;", " try", " {", " if (args.length == 0) l = new Yylex(System.in);", " else l = new Yylex(new FileReader(args[0]));", " }", " catch(FileNotFoundException e)", " {", " System.err.println(\"Error: File not found: \" + args[0]);", " System.exit(1);", " }", " p = new parser(l);", " /* The default parser is the first-defined entry point. */", " /* You may want to change this. Other options are: */", " /* " ++ (concat (intersperse ", " (showOpts (tail eps)))) ++ " */", " try", " {", " " ++ packageAbsyn ++ "." ++ def +++ "parse_tree = p.p" ++ def ++ "();", " System.out.println();", " System.out.println(\"Parse Succesful!\");", " System.out.println();", " System.out.println(\"[Abstract Syntax]\");", " System.out.println();", " System.out.println(PrettyPrinter.show(parse_tree));", " System.out.println();", " System.out.println(\"[Linearized Tree]\");", " System.out.println();", " System.out.println(PrettyPrinter.print(parse_tree));", " }", " catch(Throwable e)", " {", " System.err.println(\"At line \" + String.valueOf(l.line_num()) + \", near \\\"\" + l.buff() + \"\\\" :\");", " System.err.println(\" \" + e.getMessage());", " System.exit(1);", " }", " }", "}" ] where eps = allEntryPoints cf def = head eps showOpts [] = [] showOpts (x:[]) = if normCat x /= x then [] else ['p' : (identCat x)] showOpts (x:xs) = if normCat x /= x then (showOpts xs) else ('p' : (identCat x)) : (showOpts xs) BNFC-2.6.0.3/src/formats/java/CFtoJavaAbs.hs0000644000000000000000000001753312100475635016374 0ustar0000000000000000{- BNF Converter: Java Abstract Syntax Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Java Abstract Syntax It uses the NamedVariables module for variable naming. It returns a list of file names, and the contents to be written into that file. (In Java public classes must go in their own file.) The generated classes also support the Visitor Design Pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 24 April, 2003 Modified : 2 September, 2003 ************************************************************** -} module CFtoJavaAbs (cf2JavaAbs) where import CF import Utils((+++),(++++)) import NamedVariables hiding (IVar, getVars, varName) import Data.List import Data.Char(toLower) --Produces abstract data types in Java. --These follow Appel's "non-object oriented" version. --They also allow users to use the Visitor design pattern. type IVar = (String, Int, String) --The type of an instance variable --a # unique to that type --and an optional name (handles typedefs). --The result is a list of files which must be written to disk. --The tuple is (FileName, FileContents) cf2JavaAbs :: String -> String -> CF -> [(FilePath, String)] cf2JavaAbs packageBase packageAbsyn cf = concat (map (prData header packageBase user) (cf2dataLists cf)) where header = "package " ++ packageAbsyn ++ "; // Java Package generated by the BNF Converter.\n" user = [n | (n,_) <- tokenPragmas cf] --Generates a (possibly abstract) category class, and classes for all its rules. prData :: String -> String -> [UserDef] -> Data ->[(String, String)] prData header name user (cat, rules) = (identCat cat, header ++++ "public abstract class" +++ (identCat cat) +++ "implements" +++ name ++ ".Visitable {}\n") : prRules header name user cat rules --don't use map because some will be Nil where prRules h n u c [] = [] --this is basically a map which excludes Nil values. prRules h n u c (f:fs) = case res of ("","") -> prRules h n u c fs z -> res : (prRules h n u c fs) where res = prRule h n u c f --Generates classes for a rule, depending on what type of rule it is. prRule h name user c (fun, cats) = if isNilFun fun || isOneFun fun then ("","") --these are not represented in the AbSyn else if isConsFun fun then (fun', --this is the linked list case. unlines [ h, "public class" +++ fun' +++ "implements"+++ name ++ ".Visitable", "{", (prInstVars vs), prConstructor fun' user vs cats, prListFuncs fun', prAccept name fun', "}" ]) else (fun, --a standard rule unlines [ h, "public class" +++ fun +++ ext +++ "implements"+++ name ++ ".Visitable", "{", (prInstVars vs), prConstructor fun user vs cats, prAccept name fun, "}\n" ]) where vs = getVars cats user fun' = identCat (normCat c) --This handles the case where a LBNF label is the same as the category. ext = if fun == c then "" else "extends" +++ (identCat c) --These are all built-in list functions. --Later we could include things like lookup,insert,delete,etc. prListFuncs :: String -> String prListFuncs c = unlines [ " public" +++ c +++ "reverse()", " {", " if (" ++ v +++ "== null) return this;", " else", " {", " " ++ c ++ " tmp =" +++ v ++ ".reverse(this);", " " ++ v +++ "= null;", " return tmp;", " }", " }", " public" +++ c +++ "reverse(" ++ c +++ "prev)", " {", " if (" ++ v +++ "== null)", " {", " " ++ v +++ "= prev;", " return this;", " }", " else", " {", " " ++ c +++ "tmp =" +++ v ++ ".reverse(this);", " " ++ v +++ "= prev;", " return tmp;", " }", " }" ] where v = (map toLower c) ++ "_" --The standard accept function for the Visitor pattern prAccept :: String -> String -> String prAccept pack ty = "\n public void accept(" ++ pack ++ ".Visitor v) { v.visit" ++ ty ++ "(this); }" --A class's instance variables. prInstVars :: [IVar] -> String prInstVars [] = [] prInstVars vars@((t,n,nm):vs) = " public" +++ t +++ uniques ++ ";" ++++ (prInstVars vs') where (uniques, vs') = prUniques t vars --these functions group the types together nicely prUniques :: String -> [IVar] -> (String, [IVar]) prUniques t vs = (prVars (findIndices (\x -> case x of (y,_,_) -> y == t) vs) vs, remType t vs) prVars (x:[]) vs = case vs !! x of (t,n,nm) -> ((varName t nm) ++ (showNum n)) prVars (x:xs) vs = case vs !! x of (t,n,nm) -> ((varName t nm) ++ (showNum n)) ++ "," +++ (prVars xs vs) remType :: String -> [IVar] -> [IVar] remType _ [] = [] remType t ((t2,n,nm):ts) = if t == t2 then (remType t ts) else (t2,n,nm) : (remType t ts) --The constructor just assigns the parameters to the corresponding instance variables. prConstructor :: String -> [UserDef] -> [IVar] -> [Cat] -> String prConstructor c u vs cats = " public" +++ c ++"(" ++ (interleave types params) ++ ")" +++ "{" +++ prAssigns vs params ++ "}" where (types, params) = unzip (prParams cats u (length cats) ((length cats)+1)) interleave _ [] = [] interleave (x:[]) (y:[]) = x +++ y interleave (x:xs) (y:ys) = x +++ y ++ "," +++ (interleave xs ys) --Prints the parameters to the constructors. prParams :: [Cat] -> [UserDef] -> Int -> Int -> [(String,String)] prParams [] _ _ _ = [] prParams (c:cs) u n m = (identCat c',"p" ++ (show (m-n))) : (prParams cs u (n-1) m) where c' = typename c u --This algorithm peeks ahead in the list so we don't use map or fold prAssigns :: [IVar] -> [String] -> String prAssigns [] _ = [] prAssigns _ [] = [] prAssigns ((t,n,nm):vs) (p:ps) = if n == 1 then case findIndices (\x -> case x of (l,r,_) -> l == t) vs of [] -> (varName t nm) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) z -> ((varName t nm) ++ (showNum n)) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) else ((varName t nm) ++ (showNum n)) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) --Different than the standard NamedVariables version because of the user-defined --types. getVars :: [Cat] -> [UserDef] -> [IVar] getVars cs user = foldl (addVar user) [] (map identCat cs) where addVar user vs c = addVar' vs user 0 c addVar' [] u n c = [(c', n, nm)] where c' = typename c user nm = if c == c' then "" else c addVar' (i@(t,x,nm):is) u n c = if c == t || c == nm then if x == 0 then (t, 1, nm) : (addVar' is u 2 c) else i : (addVar' is u (x+1) c) else i : (addVar' is u n c) varName c s = (map toLower c') ++ "_" where c' = if s == "" then c else s --This makes up for the fact that there's no typedef in Java typename t user = if t == "Ident" then "String" else if t == "Char" then "Character" else if elem t user then "String" else t BNFC-2.6.0.3/src/formats/java/RegToJLex.hs0000644000000000000000000000552612100475635016113 0ustar0000000000000000module RegToJLex (printRegJLex, escapeChar) where -- modified from pretty-printer generated by the BNF converter import AbsBNF import Data.Char -- the top-level printing method printRegJLex :: Reg -> String printRegJLex = render . prt 0 -- you may want to change render and parenth render :: [String] -> String render = rend (0 :: Int) where rend i ss = case ss of "[" :ts -> cons "[" $ rend i ts "(" :ts -> cons "(" $ rend i ts t : "," :ts -> cons t $ space "," $ rend i ts t : ")" :ts -> cons t $ cons ")" $ rend i ts t : "]" :ts -> cons t $ cons "]" $ rend i ts t :ts -> space t $ rend i ts _ -> "" cons s t = s ++ t new i s = s space t s = if null s then t else t ++ s parenth :: [String] -> [String] parenth ss = ["("] ++ ss ++ [")"] -- the printer class does the job class Print a where prt :: Int -> a -> [String] prtList :: [a] -> [String] prtList = concat . map (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = [escapeChar c] prtList s = map (concat . prt 0) s escapeChar :: Char -> String escapeChar '^' = "\\x5E" -- special case, since \^ is a control character escape escapeChar x | x `elem` jlexReserved = '\\' : [x] escapeChar x = [x] -- Characters that must be escaped in JLex regular expressions jlexReserved :: [Char] jlexReserved = ['?', '*', '+', '|', '(', ')', '^', '$', '.', '[', ']', '{', '}', '"', '\\'] prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (concat [prt 2 reg0 , prt 3 reg]) RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg]) -- JLex does not support set difference --RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg]) RMinus reg0 REps -> prt i reg0 -- REps is identity for set difference RMinus RAny reg@(RChar _) -> prPrec i 3 (concat [["[^"],prt 0 reg,["]"]]) RMinus RAny (RAlts str) -> prPrec i 3 (concat [["[^"],prt 0 str,["]"]]) -- FIXME: maybe we could add cases for char - RDigit, RLetter etc. RMinus reg0 reg -> error $ "JLex does not support general set difference" RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]]) RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]]) ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]]) REps -> prPrec i 3 (["[^.]"]) RChar c -> prPrec i 3 (concat [prt 0 c]) RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]]) RSeqs str -> prPrec i 2 (concat (map (prt 0) str)) RDigit -> prPrec i 3 (concat [["{DIGIT}"]]) RLetter -> prPrec i 3 (concat [["{LETTER}"]]) RUpper -> prPrec i 3 (concat [["{CAPITAL}"]]) RLower -> prPrec i 3 (concat [["{SMALL}"]]) RAny -> prPrec i 3 (concat [["."]]) BNFC-2.6.0.3/src/formats/java/CFtoJLex.hs0000644000000000000000000001375512100475635015731 0ustar0000000000000000{- BNF Converter: Java JLex generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the JLex input file. This file is quite different than Alex or Flex. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 25 April, 2003 Modified : 2 September, 2003 ************************************************************** -} module CFtoJLex ( cf2jlex ) where import CF import RegToJLex import Utils ( (+++) ) import NamedVariables import Data.List --The environment must be returned for the parser to use. cf2jlex :: String -> String -> CF -> (String, SymEnv) cf2jlex packageBase packageAbsyn cf = (unlines $ concat $ [ prelude packageBase packageAbsyn, cMacros, lexSymbols env, restOfJLex cf ], env) where env = makeSymEnv (symbols cf ++ reservedWords cf) (0 :: Int) makeSymEnv [] _ = [] makeSymEnv (s:symbs) n = (s, "_SYMB_" ++ (show n)) : (makeSymEnv symbs (n+1)) prelude :: String -> String -> [String] prelude packageBase packageAbsyn = [ "// This JLex file was machine-generated by the BNF converter", "package" +++ packageBase ++ ";", "", "import java_cup.runtime.*;", "import " ++ packageAbsyn ++ ".*;", "%%", "%cup", "%full", "%line", "%{", " String pstring = new String();", " public int line_num() { return (yyline+1); }", " public String buff() { return new String(yy_buffer,yy_buffer_index,10).trim(); }", "%}" ] --For now all categories are included. --Optimally only the ones that are used should be generated. cMacros :: [String] cMacros = [ "LETTER = ({CAPITAL}|{SMALL})", "CAPITAL = [A-Z\\xC0-\\xD6\\xD8-\\xDE]", "SMALL = [a-z\\xDF-\\xF6\\xF8-\\xFF]", "DIGIT = [0-9]", "IDENT = ({LETTER}|{DIGIT}|['_])", "%state COMMENT", "%state CHAR", "%state CHARESC", "%state CHAREND", "%state STRING", "%state ESCAPED", "%%" ] lexSymbols :: SymEnv -> [String] lexSymbols ss = map transSym ss where transSym (s,r) = "" ++ (escapeChars s) ++ " { return new Symbol(sym." ++ r ++ "); }" restOfJLex :: CF -> [String] restOfJLex cf = [ lexComments (comments cf), userDefTokens, ifC "String" strStates, ifC "Char" chStates, ifC "Double" "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? { return new Symbol(sym._DOUBLE_, new Double(yytext())); }", ifC "Integer" "{DIGIT}+ { return new Symbol(sym._INTEGER_, new Integer(yytext())); }", ifC "Ident" "{LETTER}{IDENT}* { return new Symbol(sym._IDENT_, new String(yytext())); }" , "[ \\t\\r\\n\\f] { /* ignore white space. */ }" ] where ifC cat s = if isUsedCat cf cat then s else "" userDefTokens = unlines $ ["" ++ printRegJLex exp +++ "{ return new Symbol(sym." ++ name ++ ", yytext()); }" | (name, exp) <- tokenPragmas cf] strStates = unlines --These handle escaped characters in Strings. [ "\"\\\"\" { yybegin(STRING); }", "\\\\ { yybegin(ESCAPED); }", "\\\" { String foo = pstring; pstring = new String(); yybegin(YYINITIAL); return new Symbol(sym._STRING_, foo); }", ". { pstring += yytext(); }", "n { pstring += \"\\n\"; yybegin(STRING); }", "\\\" { pstring += \"\\\"\"; yybegin(STRING); }", "\\\\ { pstring += \"\\\\\"; yybegin(STRING); }", "t { pstring += \"\\t\"; yybegin(STRING); }", ". { pstring += yytext(); yybegin(STRING); }" ] chStates = unlines --These handle escaped characters in Chars. [ "\"'\" { yybegin(CHAR); }", "\\\\ { yybegin(CHARESC); }", "[^'] { yybegin(CHAREND); return new Symbol(sym._CHAR_, new Character(yytext().charAt(0))); }", "n { yybegin(CHAREND); return new Symbol(sym._CHAR_, new Character('\\n')); }", "t { yybegin(CHAREND); return new Symbol(sym._CHAR_, new Character('\\t')); }", ". { yybegin(CHAREND); return new Symbol(sym._CHAR_, new Character(yytext().charAt(0))); }", "\"'\" {yybegin(YYINITIAL);}" ] lexComments :: ([(String, String)], [String]) -> String lexComments (m,s) = (unlines (map lexSingleComment s)) ++ (unlines (map lexMultiComment m)) lexSingleComment :: String -> String lexSingleComment c = "\"" ++ c ++ "\"[^\\n]*\\n { /* BNFC single-line comment */ }" --There might be a possible bug here if a language includes 2 multi-line comments. --They could possibly start a comment with one character and end it with another. --However this seems rare. lexMultiComment :: (String, String) -> String lexMultiComment (b,e) = unlines [ "\"" ++ b ++ "\" { yybegin(COMMENT); }", "\"" ++ e ++ "\" { yybegin(YYINITIAL); }", ". { }", "[\\n] { }" ] -- lexReserved :: String -> String -- lexReserved s = "\"" ++ s ++ "\" { return new Symbol(sym.TS, yytext()); }" --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars = concatMap escapeChar BNFC-2.6.0.3/src/formats/java/CFtoJavaPrinter.hs0000644000000000000000000002705012100475635017305 0ustar0000000000000000{- BNF Converter: Java Pretty Printer generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Java Pretty Printer class. In addition, since there's no good way to display a class heirarchy (toString() doesn't count) in Java, it generates a method that displays the Abstract Syntax in a way similar to Haskell. This uses Appel's method and may serve as a useful example to those who wish to use it. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 24 April, 2003 Modified : 2 September, 2003 Added string buffer for efficiency (Michael, August 03) ************************************************************** -} module CFtoJavaPrinter ( cf2JavaPrinter ) where import CF import NamedVariables import Utils ( (+++) ) import Data.List import Data.Char ( toLower ) --Produces the PrettyPrinter class. --It will generate two methods "print" and "show" --print is the actual pretty printer for linearization. --show produces a Haskell-style syntax that can be extremely useful --especially for testing parser correctness. cf2JavaPrinter :: String -> String -> CF -> String cf2JavaPrinter packageBase packageAbsyn cf = unlines [ header, prEntryPoints packageAbsyn cf, unlines (map (prData packageAbsyn) groups), unlines (map (shData packageAbsyn) groups), footer ] where groups = (fixCoercions (ruleGroupsInternals cf)) header = unlines [ "package" +++ packageBase ++ ";", "import" +++ packageAbsyn ++ ".*;", "", "public class PrettyPrinter", "{", " //For certain applications increasing the initial size of the buffer may improve performance.", " private static final int INITIAL_BUFFER_SIZE = 128;", " //You may wish to change the parentheses used in precedence.", " private static final String _L_PAREN = new String(\"(\");", " private static final String _R_PAREN = new String(\")\");", prRender ] footer = unlines [ --later only include used categories " private static void pp(Integer n, int _i_) { buf_.append(n); buf_.append(\" \"); }", " private static void pp(Double d, int _i_) { buf_.append(d); buf_.append(\" \"); }", " private static void pp(String s, int _i_) { buf_.append(s); buf_.append(\" \"); }", " private static void pp(Character c, int _i_) { buf_.append(\"'\" + c.toString() + \"'\"); buf_.append(\" \"); }", " private static void sh(Integer n) { buf_.append(n); }", " private static void sh(Double d) { buf_.append(d); }", " private static void sh(Character c) { buf_.append(c); }", " private static void sh(String s) { printQuoted(s); }", " private static void printQuoted(String s) { buf_.append(\"\\\"\" + s + \"\\\"\"); }", " private static void indent()", " {", " int n = _n_;", " while (n > 0)", " {", " buf_.append(\" \");", " n--;", " }", " }", " private static void backup()", " {", " String s = buf_.toString();", -- peteg: java 1.1.8 compatibility. "", " if (s.substring(buf_.length() - 1, buf_.length()).equals(\" \")) {", " buf_.setCharAt(buf_.length() - 1, '\\\"');", " buf_.setLength(buf_.length() - 1);", " }", " }", " private static int _n_ = 0;", " private static StringBuffer buf_ = new StringBuffer(INITIAL_BUFFER_SIZE);", "}" ] --An extremely simple renderer for terminals. prRender :: String prRender = unlines [ " //You may wish to change render", " private static void render(String s)", " {", " if (s.equals(\"{\"))", " {", " buf_.append(\"\\n\");", " indent();", " buf_.append(s);", " _n_ = _n_ + 2;", " buf_.append(\"\\n\");", " indent();", " }", " else if (s.equals(\"(\") || s.equals(\"[\"))", " buf_.append(s);", " else if (s.equals(\")\") || s.equals(\"]\"))", " {", " backup();", " buf_.append(s);", " buf_.append(\" \");", " }", " else if (s.equals(\"}\"))", " {", " _n_ = _n_ - 2;", " backup();", " backup();", " buf_.append(s);", " buf_.append(\"\\n\");", " indent();", " }", " else if (s.equals(\",\"))", " {", " backup();", " buf_.append(s);", " buf_.append(\" \");", " }", " else if (s.equals(\";\"))", " {", " backup();", " buf_.append(s);", " buf_.append(\"\\n\");", " indent();", " }", " else if (s.equals(\"\")) return;", " else", " {", " buf_.append(s);", " buf_.append(\" \");", " }", " }" ] prEntryPoints :: String -> CF -> String prEntryPoints packageAbsyn cf = msg ++ concat (map prEntryPoint (allEntryPoints cf)) ++ msg2 where msg = " // print and show methods are defined for each Entry Point type.\n" msg2 = " /*** You shouldn't need to change anything beyond this point. ***/\n" prEntryPoint cat | (normCat cat) == cat = unlines [ " public static String print(" ++ packageAbsyn ++ "." ++ cat' ++ " foo)", " {", " pp(foo, 0);", " String temp = buf_.toString();", " buf_ = new StringBuffer(INITIAL_BUFFER_SIZE);", " return temp;", " }", " public static String show(" ++ packageAbsyn ++ "." ++ cat' ++ " foo)", " {", " sh(foo);", " String temp = buf_.toString();", " buf_ = new StringBuffer(INITIAL_BUFFER_SIZE);", " return temp;", " }" ] where cat' = identCat cat prEntryPoint _ = "" prData :: String -> (Cat, [Rule]) -> String prData packageAbsyn (cat, rules) = if isList cat then unlines [ " private static void pp(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo, int _i_)", " {", (prList cat rules) ++ " }" ] else unlines --not a list [ " private static void pp(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo, int _i_)", " {", (concat (map (prRule packageAbsyn) rules)) ++ " }" ] prRule :: String -> Rule -> String prRule packageAbsyn r@(Rule fun _c cats) | not (isCoercion fun) && not (isDefinedRule fun) = concat [ " if (foo instanceof" +++ packageAbsyn ++ "." ++ fun ++ ")\n", " {\n", " " ++ packageAbsyn ++ "." ++ fun +++ fnm +++ "= (" ++ packageAbsyn ++ "." ++ fun ++ ") foo;\n", lparen, cats', rparen, " }\n" ] where p = precRule r (lparen, rparen) = (" if (_i_ > " ++ (show p) ++ ") render(_L_PAREN);\n", " if (_i_ > " ++ (show p) ++ ") render(_R_PAREN);\n") cats' = case cats of [] -> "" _ -> concatMap (prCat fnm) (zip (fixOnes (numVars [] cats)) (map getPrec cats)) fnm = '_' : map toLower fun getPrec (Right {}) = 0 getPrec (Left c) = precCat c prRule _nm _ = "" prList :: Cat -> [Rule] -> String prList c rules = unlines [ " while (foo != null)", " {", " if (foo." ++ c'' ++ "_ == null)", " {", " pp(foo." ++ c' ++ "_, 0);", optsep, " }", " else", " {", " pp(foo." ++ c' ++ "_, 0);", " render(\"" ++ (escapeChars sep) ++ "\");", " }", " foo = foo." ++ c'' ++ "_;", " }" ] where c' = map toLower (identCat (normCatOfList c)) c'' = map toLower (identCat c) sep = getCons rules optsep = if hasOneFunc rules then "" else (" render(\"" ++ (escapeChars sep) ++ "\");") prCat fnm (c, p) = case c of Right t -> " render(\"" ++ escapeChars t ++ "\");\n" Left nt | "string" `isPrefixOf` nt -> " printQuoted(" ++ fnm ++ "." ++ nt ++ ");\n" | isInternalVar nt -> "" | otherwise -> " pp(" ++ fnm ++ "." ++ nt ++ ", " ++ show p ++ ");\n" --The following methods generate the Show function. shData :: String -> (Cat, [Rule]) -> String shData packageAbsyn (cat, rules) = if isList cat then unlines [ " private static void sh(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo)", " {", (shList cat rules) ++ " }" ] else unlines [ " private static void sh(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo)", " {", (concat (map (shRule packageAbsyn) rules)) ++ " }" ] shRule :: String -> Rule -> String shRule packageAbsyn (Rule fun _c cats) | not (isCoercion fun) && not (isDefinedRule fun) = unlines [ " if (foo instanceof" +++ packageAbsyn ++ "." ++ fun ++ ")", " {", " " ++ packageAbsyn ++ "." ++ fun +++ fnm +++ "= (" ++ packageAbsyn ++ "." ++ fun ++ ") foo;", members ++ " }" ] where members = concat [ lparen, " render(\"" ++ (escapeChars fun) ++ "\");\n", cats', rparen ] cats' = if allTerms cats then "" else (concat (map (shCat fnm) (fixOnes (numVars [] cats)))) (lparen, rparen) = if allTerms cats then ("","") else (" render(\"(\");\n"," render(\")\");\n") allTerms [] = True allTerms ((Left {}):_) = False allTerms (_:zs) = allTerms zs fnm = '_' : map toLower fun shRule _nm _ = "" shList :: Cat -> [Rule] -> String shList c _rules = unlines [ " while (foo != null)", " {", " if (foo." ++ c'' ++ "_ == null)", " {", " sh(foo." ++ c' ++ "_);", " }", " else", " {", " sh(foo." ++ c' ++ "_);", " render(\",\");", " }", " foo = foo." ++ c'' ++ "_;", " }" ] where c' = map toLower (identCat (normCatOfList c)) c'' = map toLower (identCat c) shCat fnm c = case c of Right {} -> "" Left nt | "list" `isPrefixOf` nt -> unlines [" render(\"[\");", " sh(" ++ fnm ++ "." ++ nt ++ ");", " render(\"]\");"] | isInternalVar nt -> "" | otherwise -> " sh(" ++ fnm ++ "." ++ nt ++ ");\n" --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) escapeChars (x:xs) = x : (escapeChars xs) isInternalVar x = x == internalCat ++ "_"BNFC-2.6.0.3/src/formats/java/CFtoVisitSkel.hs0000644000000000000000000001400312100475635016767 0ustar0000000000000000{- BNF Converter: Java Vistor skeleton generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates a Skeleton function which uses the Visitor Design Pattern, which users may find more familiar than Appel's method. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 4 August, 2003 Modified : 2 September, 2003 ************************************************************** -} module CFtoVisitSkel (cf2VisitSkel) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper) --Produces a Skeleton using the Visitor Design Pattern. --Thus the user can choose which Skeleton to use. cf2VisitSkel :: String -> String -> CF -> String cf2VisitSkel packageBase packageAbsyn cf = concat [ header, concatMap (prData packageAbsyn user) groups, concatMap prUser user, footer] where user = fst (unzip (tokenPragmas cf)) groups = (fixCoercions (ruleGroups cf)) header = unlines [ "package" +++ packageBase ++ ";", "import" +++ packageAbsyn ++ ".*;", "/*** BNFC-Generated Visitor Design Pattern Skeleton. ***/", "/* This implements the common visitor design pattern.", " Tests show it to be slightly less efficient than the", " instanceof method, but easier to use.", " Note that this method uses Visitor-traversal of lists, so", " List.accept() does NOT traverse the list. This allows different", " algorithms to use context information differently. */", "", "public class VisitSkel implements Visitor", "{" ] prUser u = " public void visit" ++ u' ++ "(String p) {}\n" where u' = ((toUpper (head u)) : (map toLower (tail u))) --this is a hack to fix a potential capitalization problem. footer = unlines [ --later only include used categories " public void visitIdent(String i) {}", " public void visitInteger(Integer i) {}", " public void visitDouble(Double d) {}", " public void visitChar(Character c) {}", " public void visitString(String s) {}", "}" ] --Traverses a category based on its type. prData :: String -> [UserDef] -> (Cat, [Rule]) -> String prData packageAbsyn user (cat, rules) = if isList cat then unlines [ " public void visit" ++ cl ++ "(" ++ packageAbsyn ++ "." ++ cl +++ vname ++ ")", " {", " while(" ++ vname ++ "!= null)", " {", " /* Code For" +++ cl +++ "Goes Here */", visitMember, " " ++ vname +++ "=" +++ vname ++ "." ++ vname ++ "_;", " }", " }" ] --Not a list: else abstract ++ (concatMap (prRule packageAbsyn user) rules) where cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl ++ "_" visitMember = if isBasic user member then " visit" ++ (funName member) ++ "(" ++ vname ++ "." ++ member ++ ");" else " " ++ vname ++ "." ++ member ++ ".accept(this);" abstract = case lookupRule cat rules of Just x -> "" Nothing -> " public void visit" ++ cl ++ "(" ++ packageAbsyn ++ "." ++ cl +++ vname ++ ") {} //abstract class\n" --traverses a standard rule. prRule :: String -> [UserDef] -> Rule -> String prRule packageAbsyn user (Rule fun c cats) | not (isCoercion fun) = unlines [ " public void visit" ++ fun ++ "(" ++ packageAbsyn ++ "." ++ fun +++ fnm ++ ")", " {", " /* Code For " ++ fun ++ " Goes Here */", "", cats' ++ " }" ] where cats' = if allTerms cats then "" else (concatMap (prCat user fnm) (fixOnes (numVars [] cats))) allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs fnm = map toLower fun prRule user nm _ = "" --Traverses a class's instance variables. prCat user fnm c = case c of (Right t) -> "" (Left nt) -> if isBasic user nt then " visit" ++ (funName nt) ++ "(" ++ fnm ++ "." ++ nt ++ ");\n" else if "list" `isPrefixOf` nt then " if (" ++ fnm ++ "." ++ nt ++ " != null) {" ++ accept ++ "}\n" else " " ++ accept ++ "\n" where accept = fnm ++ "." ++ nt ++ ".accept(this);" --Just checks if something is a basic or user-defined type. --This is because you don't -> a basic non-pointer type. isBasic :: [UserDef] -> String -> Bool isBasic user v = if elem (init v) user' then True else if "integer_" `isPrefixOf` v then True else if "char_" `isPrefixOf` v then True else if "string_" `isPrefixOf` v then True else if "double_" `isPrefixOf` v then True else if "ident_" `isPrefixOf` v then True else False where user' = map (map toLower) user --The visit-function name of a basic type funName :: String -> String funName v = if "integer_" `isPrefixOf` v then "Integer" else if "char_" `isPrefixOf` v then "Char" else if "string_" `isPrefixOf` v then "String" else if "double_" `isPrefixOf` v then "Double" else if "ident_" `isPrefixOf` v then "Ident" else (toUpper (head v)) : (init (tail v)) --User-defined type BNFC-2.6.0.3/src/formats/profile/0000755000000000000000000000000012100475635014463 5ustar0000000000000000BNFC-2.6.0.3/src/formats/profile/ProfileTop.hs0000644000000000000000000001771612100475635017116 0ustar0000000000000000{- BNF Converter: Haskell main file Copyright (C) 2004 Author: Markus Forberg, Peter Gammie, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module ProfileTop (makeAllProfile) where -- import Utils import CF import CFtoHappyProfile import CFtoAlex import CFtoAlex2 import CFtoLatex import MkErrM ---- import CFtoAbstract ---- import CFtoTemplate ---- import CFtoPrinter ---- import CFtoLayout ---- import CFtoXML import Utils import Data.Char import System.Exit(exitFailure) import Control.Monad(when) -- naming conventions nameMod :: String -> Bool -> String -> FilePath nameMod name inDir lang = if inDir then lang ++ "." ++ name else name ++ lang nameFile :: String -> String -> Bool -> String -> FilePath nameFile name ext inDir lang = if inDir then lang ++ "/" ++ name ++ "." ++ ext else name ++ lang ++ "." ++ ext absFile, absFileM, alexFile, alexFileM, dviFile, gfAbs, gfConc, happyFile, happyFileM, latexFile, errFile, errFileM, templateFile, templateFileM, printerFile, printerFileM, layoutFile, layoutFileM, psFile, tFile, tFileM, mFile :: Bool -> String -> FilePath absFile = nameFile "Abs" "hs" absFileM = nameMod "Abs" alexFile = nameFile "Lex" "x" alexFileM = nameMod "Lex" happyFile = nameFile "Par" "y" happyFileM = nameMod "Par" latexFile = nameFile "Doc" "tex" templateFile = nameFile "Skel" "hs" templateFileM = nameMod "Skel" printerFile = nameFile "Print" "hs" printerFileM = nameMod "Print" dviFile = nameFile "Doc" "dvi" psFile = nameFile "Doc" "ps" gfAbs = nameFile "" "Abs.gf" gfConc = nameFile "" "Conc.gf" tFile = nameFile "Test" "hs" tFileM = nameMod "Test" mFile inDir n = if inDir then n ++ "/" ++ "Makefile" else "Makefile" errFile b n = if b then n ++ "/" ++ "ErrM.hs" else "ErrM.hs" errFileM b n = if b then n ++ "." ++ "ErrM" else "ErrM" layoutFileM = nameMod "Layout" xmlFileM = nameMod "XML" layoutFile = nameFile "Layout" "hs" makeAllProfile :: Bool -> Bool -> Bool -> Int -> String -> CFP -> IO () makeAllProfile make alex1 inDir xml name cfp = do let absMod = absFileM inDir name lexMod = alexFileM inDir name parMod = happyFileM inDir name prMod = printerFileM inDir name layMod = layoutFileM inDir name tplMod = templateFileM inDir name errMod = errFileM inDir name let cf = cfp2cf cfp do when inDir (prepareDir name) ---- writeFileRep (absFile inDir name) $ cf2Abstract (absFileM inDir name) cf if (alex1) then do writeFileRep (alexFile inDir name) $ cf2alex lexMod errMod cf putStrLn " (Use Alex 1.1 to compile.)" else do writeFileRep (alexFile inDir name) $ cf2alex2 lexMod errMod "" False False cf putStrLn " (Use Alex 2.0 to compile.)" writeFileRep (happyFile inDir name) $ cf2HappyProfileS parMod absMod lexMod errMod cfp putStrLn " (Tested with Happy 1.13)" writeFileRep (latexFile inDir name) $ cfToLatex name cf ---- writeFileRep (templateFile inDir name) $ ---- cf2Template tplMod absMod errMod cf ---- writeFileRep (printerFile inDir name) $ cf2Printer prMod absMod cf ---- if hasLayout cf then ---- writeFileRep (layoutFile inDir name) $ cf2Layout alex1 inDir layMod lexMod cf ---- else return () writeFileRep (tFile inDir name) $ testfile inDir name (xml>0) cf writeFileRep (errFile inDir name) $ errM errMod cf if make then (writeFileRep (mFile inDir name) $ makefile inDir name) else return () ---- case xml of ---- 2 -> makeXML name True cf ---- 1 -> makeXML name False cf ---- _ -> return () makefile :: Bool -> String -> String makefile inDir name = makeA where name' = if inDir then "" else name -- Makefile is inDir ghcCommand = "ghc --make "++ tFile inDir name ++ " -o " ++ if inDir then name ++ "/" ++ "Test" else "Test" ++ name makeA = unlines [ "all:", "\thappy -gca " ++ happyFile False name', "\talex " ++ alexFile False name', "\tlatex " ++ latexFile False name', "\tdvips " ++ dviFile False name' ++ " -o " ++ psFile False name', "\t" ++ if inDir then "(" ++ "cd ..; " ++ ghcCommand ++ ")" else ghcCommand, "clean:", "\t rm -f " ++ unwords [ "*.log *.aux *.hi *.o *.dvi", psFile False name', "*.o" ], "distclean: " ++ if inDir then "" else "clean", if inDir then "\t rm -rf ../" ++ name -- erase this directory! else "\t rm -f " ++ unwords [ "Doc" ++ name ++ ".*", "Lex" ++ name ++ ".*", "Par" ++ name ++ ".*", ---- "Layout" ++ name ++ ".*", ---- "Skel" ++ name ++ ".*", ---- "Print" ++ name ++ ".*", "Test" ++ name ++ ".*", ---- "Abs" ++ name ++ ".*", "Test" ++ name, "ErrM.*", ---- name ++ ".dtd", ---- "XML" ++ name ++ ".*", "Makefile*" ] ] testfile :: Bool -> String -> Bool -> CF -> String testfile inDir name xml cf = makeA where makeA = let lay = hasLayout cf xpr = if xml then "XPrint a, " else "" in unlines ["-- automatically generated by BNF Converter", "module Main where\n", "", "import Trees", "import Profile", "import System.IO ( stdin, hGetContents )", "import System.Environment ( getArgs, getProgName )", "", "import " ++ alexFileM inDir name, "import " ++ happyFileM inDir name, ---- "import " ++ templateFileM inDir name, ---- "import " ++ printerFileM inDir name, ---- "import " ++ absFileM inDir name, ---- if lay then ("import " ++ layoutFileM inDir name) else "", ---- if xml then ("import " ++ xmlFileM inDir name) else "", "import " ++ errFileM inDir name, "", "type ParseFun = [Token] -> Err CFTree", "", "myLLexer = " ++ if lay then "resolveLayout True . myLexer" else "myLexer", "", "runFile :: ParseFun -> FilePath -> IO ()", "runFile p f = readFile f >>= run p", "", "run :: ParseFun -> String -> IO ()", "run p s = do", " let ts = myLLexer s", " let etree = p ts", " case etree of", " Ok tree -> do", " case postParse tree of", " Bad s -> do", " putStrLn \"\\nParse Failed... CFTree:\\n\"", " putStrLn $ prCFTree tree", " putStrLn s", " Ok tree -> do", " putStrLn \"\\nParse Successful!\"", " putStrLn $ \"\\n[Abstract Syntax]\\n\\n\" ++ prt tree", " Bad s -> do", " putStrLn s", " putStrLn \"\\nParse failed... tokenization:\"", " print ts", "", "main :: IO ()", "main = do args <- getArgs", " case args of", " [] -> hGetContents stdin >>= run " ++ firstParser, " [f] -> runFile " ++ firstParser ++ " f", " _ -> do progName <- getProgName", " putStrLn $ progName ++ \": excess arguments.\"" ] where firstParser = 'p' : firstEntry cf BNFC-2.6.0.3/src/formats/profile/CFtoHappyProfile.hs0000644000000000000000000001724512100475635020206 0ustar0000000000000000{- BNF Converter: Happy Generator Copyright (C) 2004 Author: Markus Forberg, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoHappyProfile ( cf2HappyProfileS ) where import CF --import Lexer import Data.List (intersperse) import Data.Char -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String -- default naming moduleName = "HappyParser" tokenName = "Token" -- The main function, that given a CF and a CFCat to parse according to, -- generates a happy module. cf2HappyProfileS :: String -> String -> String -> String -> CFP -> String cf2HappyProfileS = cf2Happy cf2Happy :: String -> String -> String -> String -> CFP -> String cf2Happy name absName lexName errName cf = unlines [header name absName lexName errName, declarations (allEntryPointsP cf), tokens (symbols cf ++ reservedWords cf), specialToks cf, delimiter, specialRules cf, prRules (rulesForHappy cf), finalize cf] -- construct the header. header :: String -> String -> String -> String -> String header modName absName lexName errName = unlines ["-- This Happy file was machine-generated by the BNF converter", "{", "module " ++ modName ++ " where", ---- "import " ++ absName, "import Trees", "import " ++ lexName, "import " ++ errName, "}" ] -- The declarations of a happy file. declarations :: [NonTerminal] -> String declarations ns = unlines [generateP ns, "%monad { Err } { thenM } { returnM }", "%tokentype { " ++ tokenName ++ " }"] where generateP [] = [] generateP (n:ns) = concat ["%name p",n'," ",n',"\n",generateP ns] where n' = identCat n -- The useless delimiter symbol. delimiter :: String delimiter = "\n%%\n" -- Generate the list of tokens and their identifiers. tokens :: [String] -> String tokens toks = "%token \n" ++ prTokens toks where prTokens [] = [] prTokens (t:tk) = " " ++ (convert t) ++ " { " ++ oneTok t ++ " }\n" ++ prTokens tk oneTok t = "PT _ (TS " ++ show t ++ ")" -- Happy doesn't allow characters such as åäö to occur in the happy file. This -- is however not a restriction, just a naming paradigm in the happy source file. convert :: String -> String convert "\\" = concat ['\'':"\\\\","\'"] convert xs = concat ['\'':(escape xs),"\'"] where escape [] = [] escape ('\'':xs) = '\\':'\'':escape xs escape (x:xs) = x:escape xs rulesForHappy :: CFP -> Rules rulesForHappy cf = map mkOne $ ruleGroupsP cf where mkOne (cat,rules) = constructRule cf rules cat -- For every non-terminal, we construct a set of rules. A rule is a sequence of -- terminals and non-terminals, and an action to be performed -- As an optimization, a pair of list rules [C] ::= "" | C k [C] -- is left-recursivized into [C] ::= "" | [C] C k. -- This could be generalized to cover other forms of list rules. constructRule :: CFP -> [RuleP] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule cf rules nt = (nt,[(p,generateAction nt (revF b r) m) | r0 <- rules, let (b,r) = if isConsFun (funRuleP r0) && elem (valCat r0) revs then (True,revSepListRule r0) else (False,r0), let (p,m) = generatePatterns cf r]) where ---- left rec optimization does not work yet revF b r = ---- if b then ("flip " ++ funRuleP r) else (funRuleP r) funRule r revs = reversibleCats cf -- Generates a string containing the semantic action. -- An action can for example be: Sum $1 $2, that is, construct an AST -- with the constructor Sum applied to the two metavariables $1 and $2. generateAction :: NonTerminal -> FunP -> [MetaVar] -> Action generateAction nt f@(_,(h,p)) ms = unwords $ (if isCoercion h then args else (fun ++ mss)) where fun = ["mkFunTree",show h,show p] mss = ["["] ++ intersperse "," ms ++ ["]"] args = intersperse "," ms -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: CFP -> RuleP -> (Pattern,[MetaVar]) generatePatterns cf r = case rhsRule r of [] -> ("{- empty -}",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> identCat c Right s -> convert s metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 ::Int ..] its] revIf c m = if (not (isConsFun (funRuleP r)) && elem c revs) then ("(reverse " ++ m ++ ")") else m -- no reversal in the left-recursive Cons rule itself revs = reversibleCats cf -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. prRules :: Rules -> String prRules = unlines . map prOne where prOne (nt,[]) = [] -- nt has only internal use prOne (nt,((p,a):ls)) = unwords [nt', "::", "{", "CFTree", "}\n" ++ nt', ":" , p, "{", a, "}", "\n" ++ pr ls] ++ "\n" where nt' = identCat nt pr [] = [] pr ((p,a):ls) = unlines [(concat $ intersperse " " [" |", p, "{", a , "}"])] ++ pr ls -- Finally, some haskell code. finalize :: CFP -> String finalize cf = unlines [ "{", "\nreturnM :: a -> Err a", "returnM = return", "\nthenM :: Err a -> (a -> Err b) -> Err b", "thenM = (>>=)", "\nhappyError :: [" ++ tokenName ++ "] -> Err a", "happyError ts =", " Bad $ \"syntax error at \" ++ tokenPos ts ++ " ++ "if null ts then [] else " ++ "(\" before \" ++ " ++ "unwords (map prToken (take 4 ts)))", "\nmyLexer = tokens", "}" ] -- aarne's modifs 8/1/2002: -- Markus's modifs 11/02/2002 -- GF literals specialToks :: CFP -> String specialToks cf = unlines $ (map aux (literals cf)) ++ ["L_err { _ }"] where aux cat = case cat of "Ident" -> "L_ident { PT _ (TV $$) }" "String" -> "L_quoted { PT _ (TL $$) }" "Integer" -> "L_integ { PT _ (TI $$) }" "Double" -> "L_doubl { PT _ (TD $$) }" "Char" -> "L_charac { PT _ (TC $$) }" own -> "L_" ++ own ++ " { PT _ (T_" ++ own ++ " " ++ posn ++ ") }" where posn = if isPositionCat cf cat then "_" else "$$" specialRules :: CFP -> String specialRules cf = unlines $ map aux (literals cf) where aux cat = case cat of "Ident" -> "Ident : L_ident { mkAtTree (AV (Ident $1)) }" "String" -> "String : L_quoted { mkAtTree (AS $1) }" "Integer" -> "Integer : L_integ { mkAtTree (AI ((read $1) :: Integer)) }" "Double" -> "Double : L_doubl { (read $1) :: Double }" ---- "Char" -> "Char : L_charac { (read $1) :: Char }" ---- own -> own ++ " : L_" ++ own ++ " { " ++ own ++ " ("++ posn ++ "$1)}" where posn = if isPositionCat cf cat then "mkPosToken " else "" BNFC-2.6.0.3/src/formats/java1.5/0000755000000000000000000000000012100475635014170 5ustar0000000000000000BNFC-2.6.0.3/src/formats/java1.5/JavaTop15.hs0000644000000000000000000002460412100475635016244 0ustar0000000000000000{- BNF Converter: Java Top File Copyright (C) 2004 Author: Markus Forsberg, Peter Gammie, Michael Pellauer, Bjorn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} ------------------------------------------------------------------- -- | -- Module : JavaTop -- Copyright : (C)opyright 2003, {markus, aarne, pellauer, peteg, bringert} at cs dot chalmers dot se -- License : GPL (see COPYING for details) -- -- Maintainer : {markus, aarne} at cs dot chalmers dot se -- Stability : alpha -- Portability : Haskell98 -- -- Top-level for the Java back end. -- -- > $Id: JavaTop15.hs,v 1.12 2007/01/08 18:20:23 aarne Exp $ ------------------------------------------------------------------- module JavaTop15 ( makeJava15 ) where ------------------------------------------------------------------- -- Dependencies. ------------------------------------------------------------------- import System.Directory ( createDirectory ) import System.IO.Error ( isAlreadyExistsError ) import System.Exit ( exitFailure ) import Utils import CF import CFtoCup15 ( cf2Cup ) import CFtoJLex15 import CFtoJavaAbs15 ( cf2JavaAbs ) import CFtoJavaPrinter15 --import CFtoJavaSkeleton import CFtoVisitSkel15 import CFtoComposVisitor import CFtoAbstractVisitor import CFtoFoldVisitor import CFtoAllVisitor import CFtoLatex import Data.Char import Data.List(intersperse) ------------------------------------------------------------------- -- | Build the Java output. -- FIXME: get everything to put the files in the right places. -- Adapt Makefile to do the business. ------------------------------------------------------------------- makeJava15 :: Bool -> Maybe String -- ^ Java package name to put the classes in -> String -- ^ Name of grammar -> CF -- ^ Grammar file -> IO () makeJava15 = mkFiles mkFiles :: Bool -> Maybe String -> String -> CF -> IO () mkFiles make inPackage name cf = do -- Create the package directories if necessary. let packageBase = case inPackage of Nothing -> name Just p -> p ++ "." ++ name packageAbsyn = packageBase ++ "." ++ "Absyn" dirBase = pkgToDir packageBase dirAbsyn = pkgToDir packageAbsyn prepareDir dirBase prepareDir dirAbsyn let absynFiles = remDups $ cf2JavaAbs packageBase packageAbsyn cf absynBaseNames = map fst absynFiles absynFileNames = map (dirAbsyn ++) absynBaseNames absynFuns = [ f | (_,ps) <- cf2data cf, (f,_) <- ps ] let writeAbsyn (filename, contents) = writeFileRep (dirAbsyn ++ filename ++ ".java") contents mapM writeAbsyn absynFiles writeFileRep (dirBase ++ "PrettyPrinter.java") $ cf2JavaPrinter packageBase packageAbsyn cf writeFileRep (dirBase ++ "VisitSkel.java") $ cf2VisitSkel packageBase packageAbsyn cf writeFileRep (dirBase ++ "ComposVisitor.java") $ cf2ComposVisitor packageBase packageAbsyn cf writeFileRep (dirBase ++ "AbstractVisitor.java") $ cf2AbstractVisitor packageBase packageAbsyn cf writeFileRep (dirBase ++ "FoldVisitor.java") $ cf2FoldVisitor packageBase packageAbsyn cf writeFileRep (dirBase ++ "AllVisitor.java") $ cf2AllVisitor packageBase packageAbsyn cf writeFileRep (dirBase ++ "Test.java") $ javaTest packageBase packageAbsyn cf --- writeFileRep ("Test" ++ name) $ "java " ++ dirBase ++ "Test $(1)" let (lex, env) = cf2jlex packageBase packageAbsyn cf writeFileRep (dirBase ++ "Yylex") lex putStrLn " (Tested with JLex 1.2.6.)" writeFileRep (dirBase ++ name ++ ".cup") $ cf2Cup packageBase packageAbsyn cf env -- FIXME: put in a doc directory? putStrLn $ " (Parser created for category " ++ firstEntry cf ++ ")" putStrLn " (Tested with CUP 0.10k)" writeFileRep (name ++ ".tex") $ cfToLatex name cf if make then writeFileRep "Makefile" $ makefile name dirBase dirAbsyn absynFileNames else return () where remDups [] = [] remDups ((a,b):as) = case lookup a as of Just {} -> remDups as Nothing -> (a, b) : (remDups as) pkgToDir :: String -> FilePath pkgToDir s = replace '.' pathSep s ++ [pathSep] -- FIXME get filenames right. -- FIXME It's almost certainly better to just feed all the Java source -- files to javac in one go. -- Replace with an ANT script? makefile :: String -> FilePath -> FilePath -> [String] -> String makefile name dirBase dirAbsyn absynFileNames = unlines [ "JAVAC = javac", "JAVAC_FLAGS = -sourcepath .", "", "JAVA = java", "JAVA_FLAGS =", "", "CUP = java_cup.Main", "CUPFLAGS = -nopositions -expect 100", "", "JLEX = JLex.Main", "", "LATEX = latex", "DVIPS = dvips", "", "all: test " ++ name ++ ".ps", "", "test: absyn " ++ unwords (map (dirBase ++) [ "Yylex.class", "PrettyPrinter.class", "Test.class", "ComposVisitor.class", "AbstractVisitor.class", "FoldVisitor.class", "AllVisitor.class", "parser.class", "sym.class", "Test.class"]), "", ".PHONY: absyn", "", "%.class: %.java", "\t${JAVAC} ${JAVAC_FLAGS} $^", "", "absyn: " ++ absynJavaSrc, "\t${JAVAC} ${JAVAC_FLAGS} $^", "", dirBase ++ "Yylex.java: " ++ dirBase ++ "Yylex", "\t${JAVA} ${JAVA_FLAGS} ${JLEX} " ++ dirBase ++ "Yylex", "", dirBase ++ "sym.java " ++ dirBase ++ "parser.java: " ++ dirBase ++ name ++ ".cup", "\t${JAVA} ${JAVA_FLAGS} ${CUP} ${CUPFLAGS} " ++ dirBase ++ name ++ ".cup", "\tmv sym.java parser.java " ++ dirBase, "", dirBase ++ "Yylex.class: " ++ dirBase ++ "Yylex.java" ++ " " ++ dirBase ++ "sym.java", "", dirBase ++ "sym.class: " ++ dirBase ++ "sym.java", "", dirBase ++ "parser.class: " ++ dirBase ++ "parser.java " ++ dirBase ++ "sym.java", "", dirBase ++ "PrettyPrinter.class: " ++ dirBase ++ "PrettyPrinter.java", "", "" ++ name ++ ".dvi: " ++ name ++ ".tex", "\t${LATEX} " ++ name ++ ".tex", "", "" ++ name ++ ".ps: " ++ name ++ ".dvi", "\t${DVIPS} " ++ name ++ ".dvi -o " ++ name ++ ".ps", -- FIXME "", "clean:", "\t rm -f " ++ dirAbsyn ++ "*.class" ++ " " ++ dirBase ++ "*.class", "\t rm -f " ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps " ++ " *.class", "", "distclean: vclean", "", "vclean:", "\t rm -f " ++ absynJavaSrc ++ " " ++ absynJavaClass, "\t rm -f " ++ dirAbsyn ++ "*.class", --- "\t rm -f " ++ "Test" ++ name, "\t rmdir " ++ dirAbsyn, "\t rm -f " ++ name ++ ".tex " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps ", "\t rm -f " ++ unwords (map (dirBase ++) [ "Yylex", name ++ ".cup", "Yylex.java", "VisitSkel.java", "ComposVisitor.java", "AbstractVisitor.java", "FoldVisitor.java", "AllVisitor.java", "PrettyPrinter.java", "Skeleton.java", "Test.java", "sym.java", "parser.java", "*.class"]), "\t rm -f Makefile", "\t rmdir -p " ++ dirBase, "" ] where absynJavaSrc = unwords (map (++ ".java") absynFileNames) absynJavaClass = unwords (map (++ ".class") absynFileNames) javaTest :: String -> String -> CF -> String javaTest packageBase packageAbsyn cf = unlines [ "package" +++ packageBase ++ ";", "import java_cup.runtime.*;", "import" +++ packageBase ++ ".*;", "import" +++ packageAbsyn ++ ".*;", "import java.io.*;", "", "public class Test", "{", " public static void main(String args[]) throws Exception", " {", " Yylex l = null;", " parser p;", " try", " {", " if (args.length == 0) l = new Yylex(System.in);", " else l = new Yylex(new FileReader(args[0]));", " }", " catch(FileNotFoundException e)", " {", " System.err.println(\"Error: File not found: \" + args[0]);", " System.exit(1);", " }", " p = new parser(l);", " /* The default parser is the first-defined entry point. */", " /* You may want to change this. Other options are: */", " /* " ++ (concat (intersperse ", " (showOpts (tail eps)))) ++ " */", " try", " {", " " ++ packageAbsyn ++ "." ++ def +++ "parse_tree = p.p" ++ def ++ "();", " System.out.println();", " System.out.println(\"Parse Succesful!\");", " System.out.println();", " System.out.println(\"[Abstract Syntax]\");", " System.out.println();", " System.out.println(PrettyPrinter.show(parse_tree));", " System.out.println();", " System.out.println(\"[Linearized Tree]\");", " System.out.println();", " System.out.println(PrettyPrinter.print(parse_tree));", " }", " catch(Throwable e)", " {", " System.err.println(\"At line \" + String.valueOf(l.line_num()) + \", near \\\"\" + l.buff() + \"\\\" :\");", " System.err.println(\" \" + e.getMessage());", " System.exit(1);", " }", " }", "}" ] where eps = allEntryPoints cf def = head eps showOpts [] = [] showOpts (x:[]) = if normCat x /= x then [] else ['p' : (identCat x)] showOpts (x:xs) = if normCat x /= x then (showOpts xs) else ('p' : (identCat x)) : (showOpts xs) BNFC-2.6.0.3/src/formats/java1.5/CFtoJavaPrinter15.hs0000644000000000000000000002732112100475635017700 0ustar0000000000000000{- BNF Converter: Java Pretty Printer generator Copyright (C) 2004 Author: Michael Pellauer, Bjorn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Java Pretty Printer class. In addition, since there's no good way to display a class heirarchy (toString() doesn't count) in Java, it generates a method that displays the Abstract Syntax in a way similar to Haskell. This uses Appel's method and may serve as a useful example to those who wish to use it. Author : Michael Pellauer (pellauer@cs.chalmers.se), Bjorn Bringert (bringert@cs.chalmers.se) License : GPL (GNU General Public License) Created : 24 April, 2003 Modified : 9 Aug, 2004 Added string buffer for efficiency (Michael, August 03) ************************************************************** -} module CFtoJavaPrinter15 ( cf2JavaPrinter ) where import CFtoJavaAbs15 import CF import NamedVariables import Utils ( (+++) ) import Data.List import Data.Char ( toLower, isSpace ) --Produces the PrettyPrinter class. --It will generate two methods "print" and "show" --print is the actual pretty printer for linearization. --show produces a Haskell-style syntax that can be extremely useful --especially for testing parser correctness. cf2JavaPrinter :: String -> String -> CF -> String cf2JavaPrinter packageBase packageAbsyn cf = unlines [ header, prEntryPoints packageAbsyn cf, unlines (map (prData packageAbsyn user) groups), unlines (map (shData packageAbsyn user) groups), footer ] where user = [n | (n,_) <- tokenPragmas cf] groups = fixCoercions (ruleGroupsInternals cf) header = unlines [ "package" +++ packageBase ++ ";", "import" +++ packageAbsyn ++ ".*;", "", "public class PrettyPrinter", "{", " //For certain applications increasing the initial size of the buffer may improve performance.", " private static final int INITIAL_BUFFER_SIZE = 128;", " //You may wish to change the parentheses used in precedence.", " private static final String _L_PAREN = new String(\"(\");", " private static final String _R_PAREN = new String(\")\");", prRender ] footer = unlines [ --later only include used categories " private static void pp(Integer n, int _i_) { buf_.append(n); buf_.append(\" \"); }", " private static void pp(Double d, int _i_) { buf_.append(d); buf_.append(\" \"); }", " private static void pp(String s, int _i_) { buf_.append(s); buf_.append(\" \"); }", " private static void pp(Character c, int _i_) { buf_.append(\"'\" + c.toString() + \"'\"); buf_.append(\" \"); }", " private static void sh(Integer n) { render(n.toString()); }", " private static void sh(Double d) { render(d.toString()); }", " private static void sh(Character c) { render(c.toString()); }", " private static void sh(String s) { printQuoted(s); }", " private static void printQuoted(String s) { render(\"\\\"\" + s + \"\\\"\"); }", " private static void indent()", " {", " int n = _n_;", " while (n > 0)", " {", " buf_.append(\" \");", " n--;", " }", " }", " private static void backup()", " {", " if (buf_.charAt(buf_.length() - 1) == ' ') {", " buf_.setLength(buf_.length() - 1);", " }", " }", " private static void trim()", " {", " while (buf_.length() > 0 && buf_.charAt(0) == ' ')", " buf_.deleteCharAt(0); ", " while (buf_.length() > 0 && buf_.charAt(buf_.length()-1) == ' ')", " buf_.deleteCharAt(buf_.length()-1);", " }", " private static int _n_ = 0;", " private static StringBuilder buf_ = new StringBuilder(INITIAL_BUFFER_SIZE);", "}" ] --An extremely simple renderer for terminals. prRender :: String prRender = unlines [ " //You may wish to change render", " private static void render(String s)", " {", " if (s.equals(\"{\"))", " {", " buf_.append(\"\\n\");", " indent();", " buf_.append(s);", " _n_ = _n_ + 2;", " buf_.append(\"\\n\");", " indent();", " }", " else if (s.equals(\"(\") || s.equals(\"[\"))", " buf_.append(s);", " else if (s.equals(\")\") || s.equals(\"]\"))", " {", " backup();", " buf_.append(s);", " buf_.append(\" \");", " }", " else if (s.equals(\"}\"))", " {", " _n_ = _n_ - 2;", " backup();", " backup();", " buf_.append(s);", " buf_.append(\"\\n\");", " indent();", " }", " else if (s.equals(\",\"))", " {", " backup();", " buf_.append(s);", " buf_.append(\" \");", " }", " else if (s.equals(\";\"))", " {", " backup();", " buf_.append(s);", " buf_.append(\"\\n\");", " indent();", " }", " else if (s.equals(\"\")) return;", " else", " {", " buf_.append(s);", " buf_.append(\" \");", " }", " }" ] prEntryPoints :: String -> CF -> String prEntryPoints packageAbsyn cf = msg ++ concat (map prEntryPoint (allCats cf)) ++ msg2 where msg = " // print and show methods are defined for each category.\n" msg2 = " /*** You shouldn't need to change anything beyond this point. ***/\n" prEntryPoint cat | (normCat cat) == cat = unlines [ " public static String print(" ++ packageAbsyn ++ "." ++ cat' ++ " foo)", " {", " pp(foo, 0);", " trim();", " String temp = buf_.toString();", " buf_.delete(0,buf_.length());", " return temp;", " }", " public static String show(" ++ packageAbsyn ++ "." ++ cat' ++ " foo)", " {", " sh(foo);", " String temp = buf_.toString();", " buf_.delete(0,buf_.length());", " return temp;", " }" ] where cat' = identCat cat prEntryPoint _ = "" prData :: String -> [UserDef] -> (Cat, [Rule]) -> String prData packageAbsyn user (cat, rules) = if isList cat then unlines [ " private static void pp(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo, int _i_)", " {", (prList user cat rules) ++ " }" ] else unlines --not a list [ " private static void pp(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo, int _i_)", " {", (concat (addElse $ map (prRule packageAbsyn) rules)) ++ " }" ] where addElse = map (" "++). intersperse "else " . filter (not . null) . map (dropWhile isSpace) prRule :: String -> Rule -> String prRule packageAbsyn r@(Rule fun _c cats) | not (isCoercion fun || isDefinedRule fun) = concat [ " if (foo instanceof" +++ packageAbsyn ++ "." ++ fun ++ ")\n", " {\n", " " ++ packageAbsyn ++ "." ++ fun +++ fnm +++ "= (" ++ packageAbsyn ++ "." ++ fun ++ ") foo;\n", lparen, cats', rparen, " }\n" ] where p = precRule r (lparen, rparen) = (" if (_i_ > " ++ (show p) ++ ") render(_L_PAREN);\n", " if (_i_ > " ++ (show p) ++ ") render(_R_PAREN);\n") cats' = case cats of [] -> "" _ -> concatMap (prCat fnm) (zip (fixOnes (numVars [] cats)) (map getPrec cats)) fnm = '_' : map toLower fun getPrec (Right {}) = 0 getPrec (Left c) = precCat c prRule _nm _ = "" prList :: [UserDef] -> Cat -> [Rule] -> String prList user c rules = unlines [ " for (java.util.Iterator<" ++ et ++ "> it = foo.iterator(); it.hasNext();)", " {", " pp(it.next(), 0);", " if (it.hasNext()) {", " render(\"" ++ sep ++ "\");", " } else {", " render(\"" ++ optsep ++ "\");", " }", " }" ] where et = typename (normCatOfList c) user sep = escapeChars $ getCons rules optsep = if hasOneFunc rules then "" else sep prCat fnm (c, p) = case c of Right t -> " render(\"" ++ escapeChars t ++ "\");\n" Left nt | "string" `isPrefixOf` nt -> " printQuoted(" ++ fnm ++ "." ++ nt ++ ");\n" | isInternalVar nt -> "" | otherwise -> " pp(" ++ fnm ++ "." ++ nt ++ ", " ++ show p ++ ");\n" --The following methods generate the Show function. shData :: String -> [UserDef] -> (Cat, [Rule]) -> String shData packageAbsyn user (cat, rules) = if isList cat then unlines [ " private static void sh(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo)", " {", (shList user cat rules) ++ " }" ] else unlines [ " private static void sh(" ++ packageAbsyn ++ "." ++ identCat (normCat cat) +++ "foo)", " {", (concat (map (shRule packageAbsyn) rules)) ++ " }" ] shRule :: String -> Rule -> String shRule packageAbsyn (Rule fun _c cats) | not (isCoercion fun || isDefinedRule fun) = unlines [ " if (foo instanceof" +++ packageAbsyn ++ "." ++ fun ++ ")", " {", " " ++ packageAbsyn ++ "." ++ fun +++ fnm +++ "= (" ++ packageAbsyn ++ "." ++ fun ++ ") foo;", members ++ " }" ] where members = concat [ lparen, " render(\"" ++ (escapeChars fun) ++ "\");\n", cats', rparen ] cats' = if allTerms cats then "" else (concat (map (shCat fnm) (fixOnes (numVars [] cats)))) (lparen, rparen) = if allTerms cats then ("","") else (" render(\"(\");\n"," render(\")\");\n") allTerms [] = True allTerms ((Left {}):_) = False allTerms (_:zs) = allTerms zs fnm = '_' : map toLower fun shRule _nm _ = "" shList :: [UserDef] -> Cat -> [Rule] -> String shList user c _rules = unlines [ " for (java.util.Iterator<" ++ et ++ "> it = foo.iterator(); it.hasNext();)", " {", " sh(it.next());", " if (it.hasNext())", " render(\",\");", " }" ] where et = typename (normCatOfList c) user shCat fnm c = case c of Right {} -> "" Left nt | "list" `isPrefixOf` nt -> unlines [" render(\"[\");", " sh(" ++ fnm ++ "." ++ nt ++ ");", " render(\"]\");"] | isInternalVar nt -> "" | otherwise -> " sh(" ++ fnm ++ "." ++ nt ++ ");\n" --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) escapeChars (x:xs) = x : (escapeChars xs) isInternalVar x = x == internalCat ++ "_" BNFC-2.6.0.3/src/formats/java1.5/CFtoJavaAbs15.hs0000644000000000000000000002313612100475635016762 0ustar0000000000000000{- BNF Converter: Java 1.5 Abstract Syntax Copyright (C) 2004 Author: Michael Pellauer, Bjorn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Java Abstract Syntax It uses the NamedVariables module for variable naming. It returns a list of file names, and the contents to be written into that file. (In Java public classes must go in their own file.) The generated classes also support the Visitor Design Pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se), Bjorn Bringert (bringert@cs.chalmers.se) License : GPL (GNU General Public License) Created : 24 April, 2003 Modified : 16 June, 2004 ************************************************************** -} module CFtoJavaAbs15 (cf2JavaAbs, typename) where import CF import Utils((+++),(++++)) import NamedVariables hiding (IVar, getVars, varName) import Data.List import Data.Char(toLower, isDigit) import Data.Maybe(catMaybes,fromMaybe) --Produces abstract data types in Java. --These follow Appel's "non-object oriented" version. --They also allow users to use the Visitor design pattern. type IVar = (String, Int, Maybe String) --The type of an instance variable --a # unique to that type --and an optional name (handles typedefs). --The result is a list of files which must be written to disk. --The tuple is (FileName, FileContents) cf2JavaAbs :: String -> String -> CF -> [(FilePath, String)] cf2JavaAbs packageBase packageAbsyn cf = concatMap (prData header packageAbsyn user) rules where header = "package " ++ packageAbsyn ++ "; // Java Package generated by the BNF Converter.\n" user = [n | (n,_) <- tokenPragmas cf] rules = [ (normCat c,fs) | (c,fs) <- cf2dataLists cf] --Generates a (possibly abstract) category class, and classes for all its rules. prData :: String -> String -> [UserDef] -> Data ->[(String, String)] prData header packageAbsyn user (cat, rules) = categoryClass ++ (catMaybes $ map (prRule header packageAbsyn funs user cat) rules) where funs = map fst rules categoryClass | cat `elem` funs = [] -- the catgory is also a function, skip abstract class | otherwise = [(identCat cat, header ++++ unlines [ "public abstract class" +++ cls +++ "implements java.io.Serializable {", " public abstract R accept(" ++ cls ++ ".Visitor v, A arg);", prVisitor packageAbsyn funs, "}" ])] where cls = identCat cat prVisitor :: String -> [String] -> String prVisitor packageAbsyn funs = unlines [ " public interface Visitor {", unlines (map prVisitFun funs), " }" ] where prVisitFun f = " public R visit(" ++ packageAbsyn ++ "." ++ f ++ " p, A arg);" --Generates classes for a rule, depending on what type of rule it is. prRule :: String -- ^ Header -> String -- ^ Abstract syntax package name -> [String] -- ^ Names of all constructors in the category -> [UserDef] -> String -> (Fun, [Cat]) -> Maybe (String, String) prRule h packageAbsyn funs user c (fun, cats) = if isNilFun fun || isOneFun fun then Nothing --these are not represented in the AbSyn else if isConsFun fun then Just $ (fun', --this is the linked list case. unlines [ h, "public class" +++ fun' +++ "extends java.util.LinkedList<"++ et ++"> {", "}" ]) else Just $ (fun, --a standard rule unlines [ h, "public class" +++ fun ++ ext +++ "{", (prInstVars vs), prConstructor fun user vs cats, prAccept packageAbsyn c fun, prEquals packageAbsyn fun vs, prHashCode packageAbsyn fun vs, if isAlsoCategory then prVisitor packageAbsyn funs else "", "}" ]) where vs = getVars cats user fun' = identCat (normCat c) isAlsoCategory = fun == c --This handles the case where a LBNF label is the same as the category. ext = if isAlsoCategory then "" else " extends" +++ (identCat c) et = typename (normCatOfList c) user --The standard accept function for the Visitor pattern prAccept :: String -> String -> String -> String prAccept pack cat _ = "\n public R accept(" ++ pack ++ "." ++ cat ++ ".Visitor v, A arg) { return v.visit(this, arg); }\n" -- Creates the equals() method. prEquals :: String -> String -> [IVar] -> String prEquals pack fun vs = unlines $ map (" "++) $ ["public boolean equals(Object o) {", " if (this == o) return true;", " if (o instanceof " ++ fqn ++ ") {"] ++ (if null vs then [" return true;"] else [" " ++ fqn +++ "x = ("++fqn++")o;", " return " ++ checkKids ++ ";"]) ++ [" }", " return false;", "}"] where fqn = pack++"."++fun checkKids = concat $ intersperse " && " $ map checkKid vs checkKid iv = "this." ++ v ++ ".equals(x." ++ v ++ ")" where v = iVarName iv -- Creates the equals() method. prHashCode :: String -> String -> [IVar] -> String prHashCode pack fun vs = unlines $ map (" "++) ["public int hashCode() {", " return " ++ hashKids vs ++ ";", "}" ] where aPrime = 37 hashKids [] = show aPrime hashKids (v:vs) = hashKids_ (hashKid v) vs hashKids_ r [] = r hashKids_ r (v:vs) = hashKids_ (show aPrime ++ "*" ++ "(" ++ r ++ ")+" ++ hashKid v) vs hashKid iv = "this." ++ iVarName iv ++ ".hashCode()" --A class's instance variables. prInstVars :: [IVar] -> String prInstVars [] = [] prInstVars vars@((t,n,nm):vs) = " public" +++ "final" +++ t +++ uniques ++ ";" ++++ (prInstVars vs') where (uniques, vs') = prUniques t vars --these functions group the types together nicely prUniques :: String -> [IVar] -> (String, [IVar]) prUniques t vs = (prVars (findIndices (\x -> case x of (y,_,_) -> y == t) vs) vs, remType t vs) prVars (x:[]) vs = iVarName (vs!!x) prVars (x:xs) vs = iVarName (vs!!x) ++ "," +++ prVars xs vs remType :: String -> [IVar] -> [IVar] remType _ [] = [] remType t ((t2,n,nm):ts) = if t == t2 then (remType t ts) else (t2,n,nm) : (remType t ts) iVarName :: IVar -> String iVarName (t,n,nm) = varName t nm ++ showNum n --The constructor just assigns the parameters to the corresponding instance variables. prConstructor :: String -> [UserDef] -> [IVar] -> [Cat] -> String prConstructor c u vs cats = " public" +++ c ++"(" ++ (interleave types params) ++ ")" +++ "{" +++ prAssigns vs params ++ "}" where (types, params) = unzip (prParams cats u (length cats) ((length cats)+1)) interleave _ [] = [] interleave (x:[]) (y:[]) = x +++ y interleave (x:xs) (y:ys) = x +++ y ++ "," +++ (interleave xs ys) --Prints the parameters to the constructors. prParams :: [Cat] -> [UserDef] -> Int -> Int -> [(String,String)] prParams [] _ _ _ = [] prParams (c:cs) u n m = (identCat c',"p" ++ (show (m-n))) : (prParams cs u (n-1) m) where c' = typename c u --This algorithm peeks ahead in the list so we don't use map or fold prAssigns :: [IVar] -> [String] -> String prAssigns [] _ = [] prAssigns _ [] = [] prAssigns ((t,n,nm):vs) (p:ps) = if n == 1 then case findIndices (\x -> case x of (l,r,_) -> l == t) vs of [] -> (varName t nm) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) z -> ((varName t nm) ++ (showNum n)) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) else ((varName t nm) ++ (showNum n)) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) --Different than the standard NamedVariables version because of the user-defined --types. getVars :: [Cat] -> [UserDef] -> [IVar] getVars cs user = reverse $ singleToZero $ foldl addVar [] (map identCat cs) where addVar is c = (c', n, nm):is where c' = typename c user nm = if c == c' then Nothing else Just c n = maximum (1:[n'+1 | (t,n',_) <- is, t == c']) singleToZero is = [(t,n',nm) | (t,n,nm) <- is, let n' = if length (filter (hasType t) is) == 1 then 0 else n] hasType t (t',_,_) = t == t' varName :: String -- ^ Category -> Maybe String -- ^ Java type name -> String -- ^ Variable name varName c jt = (map toLower c') ++ "_" where c' = fromMaybe c jt --This makes up for the fact that there's no typedef in Java typename :: String -> [UserDef] -> String typename t user = if t == "Ident" then "String" else if t == "Char" then "Character" else if elem t user then "String" else t BNFC-2.6.0.3/src/formats/java1.5/CFtoVisitSkel15.hs0000644000000000000000000001136312100475635017367 0ustar0000000000000000{- BNF Converter: Java Vistor skeleton generator Copyright (C) 2004 Author: Michael Pellauer, Bjorn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates a Skeleton function which uses the Visitor Design Pattern, which users may find more familiar than Appel's method. Author : Michael Pellauer (pellauer@cs.chalmers.se), Bjorn Bringert (bringert@cs.chalmers.se) License : GPL (GNU General Public License) Created : 4 August, 2003 Modified : 16 June, 2004 ************************************************************** -} module CFtoVisitSkel15 (cf2VisitSkel) where import CF import CFtoJavaAbs15 (typename) import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper, isDigit) --Produces a Skeleton using the Visitor Design Pattern. --Thus the user can choose which Skeleton to use. cf2VisitSkel :: String -> String -> CF -> String cf2VisitSkel packageBase packageAbsyn cf = concat [ header, -- " // NOT IMPLEMENTED for java1.5\n", concatMap (prData packageAbsyn user) groups, "}"] where user = fst (unzip (tokenPragmas cf)) groups = (fixCoercions (ruleGroups cf)) header = unlines [ "package" +++ packageBase ++ ";", "import" +++ packageAbsyn ++ ".*;", "/*** BNFC-Generated Visitor Design Pattern Skeleton. ***/", "/* This implements the common visitor design pattern.", " Tests show it to be slightly less efficient than the", " instanceof method, but easier to use. ", " Replace the R and A parameters with the desired return", " and context types.*/", "", "public class VisitSkel", "{" ] --Traverses a category based on its type. prData :: String -> [UserDef] -> (Cat, [Rule]) -> String prData packageAbsyn user (cat, rules) = if isList cat then "" else unlines [" public class " ++ identCat cat ++ "Visitor implements " ++ identCat cat ++ ".Visitor", " {", concatMap (prRule packageAbsyn user) rules, " }" ] --traverses a standard rule. prRule :: String -> [UserDef] -> Rule -> String prRule packageAbsyn user (Rule fun c cats) | not (isCoercion fun || isDefinedRule fun) = unlines [ " public R visit(" ++ packageAbsyn ++ "." ++ fun ++ " p, A arg)", " {", " /* Code For " ++ fun ++ " Goes Here */", "", concatMap (uncurry (prCat user)) cats', " return null;", " }" ] where cats' = if allTerms cats then [] else [ (c,v) | (Left c, Left v) <- zip cats (fixOnes (numVars [] cats)) ] allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs prRule user nm _ = "" --Traverses a class's instance variables. prCat :: [UserDef] -> Cat -- ^ Variable category -> String -- ^ Variable name -> String -- ^ Code for visiting the variable prCat user cat nt | isBasic user nt = " //" ++ var ++ ";\n" | "list" `isPrefixOf` nt = listAccept | otherwise = " " ++ accept ++ "\n" where var = "p." ++ nt varType = typename (normCat (identCat cat)) user accept = var ++ ".accept(new " ++ varType ++ "Visitor(), arg);" et = typename (normCatOfList cat) user listAccept = unlines [" for (" ++ et ++ " x : " ++ var ++ ") {", " }"] --Just checks if something is a basic or user-defined type. --This is because you don't -> a basic non-pointer type. isBasic :: [UserDef] -> String -> Bool isBasic user v = if elem (init v) user' then True else if "integer_" `isPrefixOf` v then True else if "char_" `isPrefixOf` v then True else if "string_" `isPrefixOf` v then True else if "double_" `isPrefixOf` v then True else if "ident_" `isPrefixOf` v then True else False where user' = map (map toLower) user BNFC-2.6.0.3/src/formats/java1.5/CFtoFoldVisitor.hs0000644000000000000000000000727712100475635017561 0ustar0000000000000000{- BNF Converter: Java 1.5 Fold Vistor generator Copyright (C) 2006 Bjorn Bringert Based on CFtoVisitSkel.hs, Copyright (C) 2004-2006 Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoFoldVisitor (cf2FoldVisitor) where import CF import CFtoJavaAbs15 (typename) import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper, isDigit) cf2FoldVisitor :: String -> String -> CF -> String cf2FoldVisitor packageBase packageAbsyn cf = unlines ["package" +++ packageBase ++ ";", "", "import" +++ packageAbsyn ++ ".*;", "import java.util.Collections;", "import java.util.List;", "import java.util.ArrayList;", "", "/** BNFC-Generated Fold Visitor */", "public abstract class FoldVisitor implements AllVisitor {", " public abstract R leaf(A arg);", " public abstract R combine(R x, R y, A arg);", "", concatMap (prData packageAbsyn user) groups, "}"] where user = fst (unzip (tokenPragmas cf)) groups = [ g | g@(c,_) <- fixCoercions (ruleGroupsInternals cf), not (isList c) ] --Traverses a category based on its type. prData :: String -> [UserDef] -> (Cat, [Rule]) -> String prData packageAbsyn user (cat, rules) = unlines [ "/* " ++ identCat cat ++ " */", concatMap (prRule packageAbsyn user cat) rules ] --traverses a standard rule. prRule :: String -> [UserDef] -> Cat -> Rule -> String prRule packageAbsyn user cat (Rule fun _ cats) | not (isCoercion fun || isDefinedRule fun) = unlines $ [" public R visit(" ++ cls ++ " p, A arg) {", " R r = leaf(arg);"] ++ map (" "++) visitVars ++ [" return r;", " }"] where cats' = if allTerms cats then [] else [ (c,v) | (Left c, Left v) <- zip cats (fixOnes (numVars [] cats)), c /= internalCat ] cls = packageAbsyn ++ "." ++ fun allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs children = map snd cats' visitVars = concatMap (uncurry (prCat user)) cats' prRule _ _ _ _ = "" --Traverses a class's instance variables. prCat :: [UserDef] -> Cat -- ^ Variable category -> String -- ^ Variable name -> [String] -- ^ Code for visiting the variable prCat user cat nt | isBasicType user varType || (isListType varType && isBasicType user et) = [] | isListType varType = listAccept | otherwise = ["r = combine(" ++ var ++ ".accept(this, arg), r, arg);"] where var = "p." ++ nt varType = typename (normCat (identCat cat)) user et = typename (normCatOfList cat) user listAccept = ["for (" ++ et ++ " x : " ++ var ++ ") {", " r = combine(x.accept(this,arg), r, arg);", "}"] isListType :: String -> Bool isListType nt = "List" `isPrefixOf` nt --Just checks if something is a basic or user-defined type. isBasicType :: [UserDef] -> String -> Bool isBasicType user v = v `elem` (user ++ ["Integer","Character","String","Double"]) BNFC-2.6.0.3/src/formats/java1.5/CFtoComposVisitor.hs0000644000000000000000000001005712100475635020123 0ustar0000000000000000{- BNF Converter: Java 1.5 Compositional Vistor generator Copyright (C) 2006 Bjorn Bringert Based on CFtoVisitSkel.hs, Copyright (C) 2004-2006 Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoComposVisitor (cf2ComposVisitor) where import CF import CFtoJavaAbs15 (typename) import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper, isDigit) cf2ComposVisitor :: String -> String -> CF -> String cf2ComposVisitor packageBase packageAbsyn cf = concat [ header, concatMap (prData packageAbsyn user) groups, "}"] where user = fst (unzip (tokenPragmas cf)) groups = [ g | g@(c,_) <- fixCoercions (ruleGroupsInternals cf), not (isList c) ] is = map (prInterface packageAbsyn) groups header = unlines [ "package" +++ packageBase ++ ";", "import" +++ packageAbsyn ++ ".*;", "/** BNFC-Generated Composition Visitor", "*/", "", "public class ComposVisitor implements", concat $ intersperse ",\n" $ map (" "++) is, "{" ] prInterface :: String -> (Cat, [Rule]) -> String prInterface packageAbsyn (cat, rules) = q ++ ".Visitor<" ++ q ++ ",A>" where q = packageAbsyn ++ "." ++ identCat cat commaList :: [String] -> String commaList = concat . intersperse ", " --Traverses a category based on its type. prData :: String -> [UserDef] -> (Cat, [Rule]) -> String prData packageAbsyn user (cat, rules) = unlines [ "/* " ++ identCat cat ++ " */", concatMap (prRule packageAbsyn user cat) rules ] --traverses a standard rule. prRule :: String -> [UserDef] -> Cat -> Rule -> String prRule packageAbsyn user cat (Rule fun _ cats) | not (isCoercion fun || isDefinedRule fun) = unlines [ " public " ++ identCat cat ++ " visit(" ++ cls ++ " p, A arg)", " {", unlines (map (" "++) visitVars), " return new " ++ cls ++ "(" ++ commaList children ++ ");", " }" ] where cats' = if allTerms cats then [] else [ (c,v) | (Left c, Left v) <- zip cats (fixOnes (numVars [] cats)), c /= internalCat ] cls = packageAbsyn ++ "." ++ fun allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs children = map snd cats' visitVars = concatMap (uncurry (prCat user)) cats' prRule _ _ _ _ = "" --Traverses a class's instance variables. prCat :: [UserDef] -> Cat -- ^ Variable category -> String -- ^ Variable name -> [String] -- ^ Code for visiting the variable prCat user cat nt | isBasicType user varType || (isListType varType && isBasicType user et) = [decl var] | isListType varType = listAccept | otherwise = [decl (var ++ ".accept(this, arg)")] where var = "p." ++ nt varType = typename (normCat (identCat cat)) user accept = var ++ ".accept(this, arg);" et = typename (normCatOfList cat) user decl v = varType +++ nt +++ "=" +++ v ++ ";" listAccept = [decl ("new"+++varType++"()"), "for (" ++ et ++ " x : " ++ var ++ ") {", " " ++ nt ++ ".add(x.accept(this,arg));", "}"] isListType :: String -> Bool isListType nt = "List" `isPrefixOf` nt --Just checks if something is a basic or user-defined type. isBasicType :: [UserDef] -> String -> Bool isBasicType user v = v `elem` (user ++ ["Integer","Character","String","Double"]) BNFC-2.6.0.3/src/formats/java1.5/CFtoCup15.hs0000644000000000000000000002277212100475635016207 0ustar0000000000000000{- BNF Converter: Java 1.5 Cup Generator Copyright (C) 2004 Author: Markus Forsberg, Michael Pellauer, Bjorn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the CUP input file. It follows the same basic structure of CFtoHappy. Author : Michael Pellauer (pellauer@cs.chalmers.se), Bjorn Bringert (bringert@cs.chalmers.se) License : GPL (GNU General Public License) Created : 26 April, 2003 Modified : 5 Aug, 2004 ************************************************************** -} module CFtoCup15 ( cf2Cup ) where import CF import Data.List (intersperse, isPrefixOf) import NamedVariables import Utils ( (+++) ) import TypeChecker -- We need to (re-)typecheck to figure out list instances in -- defined rules. import ErrM import Data.Char -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String --The environment comes from the CFtoJLex cf2Cup :: String -> String -> CF -> SymEnv -> String cf2Cup packageBase packageAbsyn cf env = unlines [ header, declarations packageAbsyn (allCats cf), tokens env, specialToks cf, specialRules cf, prEntryPoint cf, prRules (rulesForCup packageAbsyn cf env) ] where header :: String header = unlines ["// -*- Java -*- This Cup file was machine-generated by BNFC", "package" +++ packageBase ++ ";", "", "parser code {:", parseMethod packageAbsyn (firstEntry cf), "public > A cons_(B x, A xs) { xs.addFirst(x); return xs; }", definedRules packageAbsyn cf, -- unlines $ map (parseMethod packageAbsyn) (allEntryPoints cf), "public void syntax_error(java_cup.runtime.Symbol cur_token)", "{", "\treport_error(\"Syntax Error, trying to recover and continue parse...\", cur_token);", "}", "", "public void unrecovered_syntax_error(java_cup.runtime.Symbol cur_token) throws java.lang.Exception", "{", "\tthrow new Exception(\"Unrecoverable Syntax Error\");", "}", "", ":}" ] definedRules :: String -> CF -> String definedRules packageAbsyn cf = unlines [ rule f xs e | FunDef f xs e <- pragmasOfCF cf ] where ctx = buildContext cf list = LC (\t -> "List" ++ unBase t) (const "cons") where unBase (ListT t) = unBase t unBase (BaseT x) = normCat x rule f xs e = case checkDefinition' list ctx f xs e of Bad err -> error $ "Panic! This should have been caught already:\n" ++ err Ok (args,(e',t)) -> unlines [ "public " ++ javaType t ++ " " ++ f ++ "_ (" ++ concat (intersperse ", " $ map javaArg args) ++ ") {" , " return " ++ javaExp e' ++ ";" , "}" ] where javaType :: Base -> String javaType (ListT (BaseT x)) = packageAbsyn ++ ".List" ++ normCat x javaType (ListT t) = javaType t javaType (BaseT x) | isToken x ctx = "String" | otherwise = packageAbsyn ++ "." ++ normCat x javaArg :: (String, Base) -> String javaArg (x,t) = javaType t ++ " " ++ x ++ "_" javaExp :: Exp -> String javaExp (App "null" []) = "null" javaExp (App x []) | elem x xs = x ++ "_" -- argument javaExp (App t [e]) | isToken t ctx = call ("new String") [e] javaExp (App x es) | isUpper (head x) = call ("new " ++ packageAbsyn ++ "." ++ x) es | otherwise = call (x ++ "_") es javaExp (LitInt n) = "new Integer(" ++ show n ++ ")" javaExp (LitDouble x) = "new Double(" ++ show x ++ ")" javaExp (LitChar c) = "new Character(" ++ show c ++ ")" javaExp (LitString s) = "new String(" ++ show s ++ ")" call x es = x ++ "(" ++ concat (intersperse ", " $ map javaExp es) ++ ")" -- peteg: FIXME JavaCUP can only cope with one entry point AFAIK. prEntryPoint :: CF -> String prEntryPoint cf = unlines ["", "start with " ++ firstEntry cf ++ ";", ""] -- [ep] -> unlines ["", "start with " ++ ep ++ ";", ""] -- eps -> error $ "FIXME multiple entry points." ++ show eps --This generates a parser method for each entry point. parseMethod :: String -> Cat -> String parseMethod packageAbsyn cat = if normCat cat /= cat then "" else unlines [ " public" +++ packageAbsyn ++ "." ++ cat' +++ "p" ++ cat' ++ "()" ++ " throws Exception", " {", "\tjava_cup.runtime.Symbol res = parse();", "\treturn (" ++ packageAbsyn ++ "." ++ cat' ++ ") res.value;", " }" ] where cat' = identCat (normCat cat) --non-terminal types declarations :: String -> [NonTerminal] -> String declarations packageAbsyn ns = unlines (map (typeNT packageAbsyn) ns) where typeNT _nm nt = "nonterminal" +++ packageAbsyn ++ "." ++ identCat (normCat nt) +++ identCat nt ++ ";" --terminal types tokens :: SymEnv -> String tokens ts = unlines (map declTok ts) where declTok (s,r) = "terminal" +++ r ++ "; // " ++ s specialToks :: CF -> String specialToks cf = unlines [ ifC "String" "terminal String _STRING_;", ifC "Char" "terminal Character _CHAR_;", ifC "Integer" "terminal Integer _INTEGER_;", ifC "Double" "terminal Double _DOUBLE_;", ifC "Ident" "terminal String _IDENT_;" ] where ifC cat s = if isUsedCat cf cat then s else "" -- This handles user defined tokens -- FIXME specialRules:: CF -> String specialRules cf = unlines ["terminal String " ++ name ++ ";" | (name, _) <- tokenPragmas cf] --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForCup :: String -> CF -> SymEnv -> Rules rulesForCup packageAbsyn cf env = map mkOne $ ruleGroups cf where mkOne (cat,rules) = constructRule packageAbsyn cf env rules cat -- For every non-terminal, we construct a set of rules. A rule is a sequence of -- terminals and non-terminals, and an action to be performed. constructRule :: String -> CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule packageAbsyn cf env rules nt = (nt, [(p,generateAction packageAbsyn nt (funRule r) (revM b m) b) | r0 <- rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True, revSepListRule r0) else (False, r0) (p,m) = generatePatterns cf env r]) where revM False m = m revM True [h,t] = [t,h] revs = reversibleCats cf -- Generates a string containing the semantic action. generateAction :: String -> NonTerminal -> Fun -> [MetaVar] -> Bool -- ^ Whether the list should be reversed or not. -- Only used if this is a list rule. -> Action generateAction packageAbsyn nt f ms rev | isNilFun f = "RESULT = new " ++ c ++ "();" | isOneFun f = "RESULT = new " ++ c ++ "(); RESULT.addLast(" ++ p_1 ++ ");" | isConsFun f = "RESULT = " ++ p_2 ++ "; " ++ p_2 ++ "." ++ add ++ "(" ++ p_1 ++ ");" | isCoercion f = "RESULT = " ++ p_1 ++ ";" | isDefinedRule f = "RESULT = parser." ++ f ++ "_" ++ "(" ++ concat (intersperse "," ms) ++ ");" | otherwise = "RESULT = new " ++ c ++ "(" ++ concat (intersperse "," ms) ++ ");" where c = packageAbsyn ++ "." ++ if isNilFun f || isOneFun f || isConsFun f then identCat (normCat nt) else f p_1 = ms!!0 p_2 = ms!!1 add = if rev then "addLast" else "addFirst" -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: CF -> SymEnv -> Rule -> (Pattern,[MetaVar]) generatePatterns cf env r = case rhsRule r of [] -> (" /* empty */ ",[]) its -> (mkIt env 1 its, metas its) where mkIt _env _n [] = [] mkIt env n (i:is) = case i of Left c -> c' ++ ":p_" ++ (show (n :: Int)) +++ (mkIt env (n+1) is) where c' = case c of "Ident" -> "_IDENT_" "Integer" -> "_INTEGER_" "Char" -> "_CHAR_" "Double" -> "_DOUBLE_" "String" -> "_STRING_" _ -> identCat c Right s -> case (lookup s env) of (Just x) -> x +++ (mkIt env (n+1) is) (Nothing) -> (mkIt env n is) metas its = ["p_" ++ show i | (i,Left c) <- zip [1 :: Int ..] its] -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. prRules :: Rules -> String prRules [] = [] prRules ((nt, []):rs) = prRules rs --internal rule prRules ((nt,((p,a):ls)):rs) = (unwords [nt', "::=", p, "{:", a, ":}", "\n" ++ pr ls]) ++ ";\n" ++ prRules rs where nt' = identCat nt pr [] = [] pr ((p,a):ls) = (unlines [(concat $ intersperse " " [" |", p, "{:", a , ":}"])]) ++ pr ls BNFC-2.6.0.3/src/formats/java1.5/CFtoJLex15.hs0000644000000000000000000001400612100475635016311 0ustar0000000000000000{- BNF Converter: Java JLex generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the JLex input file. This file is quite different than Alex or Flex. Author : Michael Pellauer (pellauer@cs.chalmers.se), Bjorn Bringert (bringert@cs.chalmers.se) License : GPL (GNU General Public License) Created : 25 April, 2003 Modified : 4 Nov, 2004 ************************************************************** -} module CFtoJLex15 ( cf2jlex ) where import CF import RegToJLex import Utils ( (+++) ) import NamedVariables import Data.List --The environment must be returned for the parser to use. cf2jlex :: String -> String -> CF -> (String, SymEnv) cf2jlex packageBase packageAbsyn cf = (unlines $ concat $ [ prelude packageBase packageAbsyn, cMacros, lexSymbols env, restOfJLex cf ], env) where env = makeSymEnv (symbols cf ++ reservedWords cf) (0 :: Int) makeSymEnv [] _ = [] makeSymEnv (s:symbs) n = (s, "_SYMB_" ++ (show n)) : (makeSymEnv symbs (n+1)) prelude :: String -> String -> [String] prelude packageBase packageAbsyn = [ "// This JLex file was machine-generated by the BNF converter", "package" +++ packageBase ++ ";", "", "import java_cup.runtime.*;", "%%", "%cup", "%unicode", "%line", "%public", "%{", " String pstring = new String();", " public int line_num() { return (yyline+1); }", " public String buff() { return new String(yy_buffer,yy_buffer_index,10).trim(); }", "%}" ] --For now all categories are included. --Optimally only the ones that are used should be generated. cMacros :: [String] cMacros = [ "LETTER = ({CAPITAL}|{SMALL})", "CAPITAL = [A-Z\\xC0-\\xD6\\xD8-\\xDE]", "SMALL = [a-z\\xDF-\\xF6\\xF8-\\xFF]", "DIGIT = [0-9]", "IDENT = ({LETTER}|{DIGIT}|['_])", "%state COMMENT", "%state CHAR", "%state CHARESC", "%state CHAREND", "%state STRING", "%state ESCAPED", "%%" ] lexSymbols :: SymEnv -> [String] lexSymbols ss = map transSym ss where transSym (s,r) = "" ++ (escapeChars s) ++ " { return new Symbol(sym." ++ r ++ "); }" restOfJLex :: CF -> [String] restOfJLex cf = [ lexComments (comments cf), userDefTokens, ifC "String" strStates, ifC "Char" chStates, ifC "Double" "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? { return new Symbol(sym._DOUBLE_, new Double(yytext())); }", ifC "Integer" "{DIGIT}+ { return new Symbol(sym._INTEGER_, new Integer(yytext())); }", ifC "Ident" "{LETTER}{IDENT}* { return new Symbol(sym._IDENT_, yytext().intern()); }" , "[ \\t\\r\\n\\f] { /* ignore white space. */ }" ] where ifC cat s = if isUsedCat cf cat then s else "" userDefTokens = unlines $ ["" ++ printRegJLex exp +++ "{ return new Symbol(sym." ++ name ++ ", yytext().intern()); }" | (name, exp) <- tokenPragmas cf] strStates = unlines --These handle escaped characters in Strings. [ "\"\\\"\" { yybegin(STRING); }", "\\\\ { yybegin(ESCAPED); }", "\\\" { String foo = pstring; pstring = new String(); yybegin(YYINITIAL); return new Symbol(sym._STRING_, foo.intern()); }", ". { pstring += yytext(); }", "n { pstring += \"\\n\"; yybegin(STRING); }", "\\\" { pstring += \"\\\"\"; yybegin(STRING); }", "\\\\ { pstring += \"\\\\\"; yybegin(STRING); }", "t { pstring += \"\\t\"; yybegin(STRING); }", ". { pstring += yytext(); yybegin(STRING); }" ] chStates = unlines --These handle escaped characters in Chars. [ "\"'\" { yybegin(CHAR); }", "\\\\ { yybegin(CHARESC); }", "[^'] { yybegin(CHAREND); return new Symbol(sym._CHAR_, new Character(yytext().charAt(0))); }", "n { yybegin(CHAREND); return new Symbol(sym._CHAR_, new Character('\\n')); }", "t { yybegin(CHAREND); return new Symbol(sym._CHAR_, new Character('\\t')); }", ". { yybegin(CHAREND); return new Symbol(sym._CHAR_, new Character(yytext().charAt(0))); }", "\"'\" {yybegin(YYINITIAL);}" ] lexComments :: ([(String, String)], [String]) -> String lexComments (m,s) = (unlines (map lexSingleComment s)) ++ (unlines (map lexMultiComment m)) lexSingleComment :: String -> String lexSingleComment c = "\"" ++ c ++ "\"[^\\n]*\\n { /* BNFC single-line comment */ }" --There might be a possible bug here if a language includes 2 multi-line comments. --They could possibly start a comment with one character and end it with another. --However this seems rare. lexMultiComment :: (String, String) -> String lexMultiComment (b,e) = unlines [ "\"" ++ b ++ "\" { yybegin(COMMENT); }", "\"" ++ e ++ "\" { yybegin(YYINITIAL); }", ". { }", "[\\n] { }" ] -- lexReserved :: String -> String -- lexReserved s = "\"" ++ s ++ "\" { return new Symbol(sym.TS, yytext()); }" --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars = concatMap escapeChar BNFC-2.6.0.3/src/formats/java1.5/CFtoAbstractVisitor.hs0000644000000000000000000000461112100475635020425 0ustar0000000000000000{- BNF Converter: Java 1.5 Abstract Vistor generator Copyright (C) 2006 Bjorn Bringert Based on CFtoVisitSkel.hs, Copyright (C) 2004-2006 Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoAbstractVisitor (cf2AbstractVisitor) where import CF import CFtoJavaAbs15 (typename) import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper, isDigit) cf2AbstractVisitor :: String -> String -> CF -> String cf2AbstractVisitor packageBase packageAbsyn cf = unlines [ "package" +++ packageBase ++ ";", "import" +++ packageAbsyn ++ ".*;", "/** BNFC-Generated Abstract Visitor */", "public class AbstractVisitor implements AllVisitor {", concatMap (prData packageAbsyn user) groups, "}"] where user = fst (unzip (tokenPragmas cf)) groups = [ g | g@(c,_) <- fixCoercions (ruleGroupsInternals cf), not (isList c) ] --Traverses a category based on its type. prData :: String -> [UserDef] -> (Cat, [Rule]) -> String prData packageAbsyn user (cat, rules) = unlines $ ["/* " ++ identCat cat ++ " */"] ++ map (prRule packageAbsyn user cat) rules ++ [" public R visitDefault(" ++ q ++ " p, A arg) {", " throw new IllegalArgumentException(this.getClass().getName() + \": \" + p);", " }"] where q = packageAbsyn ++ "." ++ identCat cat --traverses a standard rule. prRule :: String -> [UserDef] -> Cat -> Rule -> String prRule packageAbsyn user cat (Rule fun _ cats) | not (isCoercion fun || isDefinedRule fun) = " public R visit(" ++ cls ++ " p, A arg) { return visitDefault(p, arg); }" where cls = packageAbsyn ++ "." ++ fun prRule _ _ _ _ = "" BNFC-2.6.0.3/src/formats/java1.5/CFtoAllVisitor.hs0000644000000000000000000000346012100475635017373 0ustar0000000000000000{- BNF Converter: Java 1.5 All Visitor generator Copyright (C) 2006 Bjorn Bringert Based on CFtoVisitSkel.hs, Copyright (C) 2004-2006 Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoAllVisitor (cf2AllVisitor) where import CF import CFtoJavaAbs15 (typename) import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper, isDigit) cf2AllVisitor :: String -> String -> CF -> String cf2AllVisitor packageBase packageAbsyn cf = unlines [ "package" +++ packageBase ++ ";", "", "import" +++ packageAbsyn ++ ".*;", "", "/** BNFC-Generated All Visitor */", "public interface AllVisitor extends", concat $ intersperse ",\n" $ map (" "++) is, "{}"] where groups = [ g | g@(c,_) <- fixCoercions (ruleGroupsInternals cf), not (isList c) ] is = map (prInterface packageAbsyn) groups header = unlines [ ] prInterface :: String -> (Cat, [Rule]) -> String prInterface packageAbsyn (cat, rules) = q ++ ".Visitor" where q = packageAbsyn ++ "." ++ identCat cat BNFC-2.6.0.3/src/formats/cpp/0000755000000000000000000000000012100475635013605 5ustar0000000000000000BNFC-2.6.0.3/src/formats/cpp/CFtoFlex.hs0000644000000000000000000001653112100475635015621 0ustar0000000000000000{- BNF Converter: Flex generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Flex file. It is similar to JLex but with a few peculiarities. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 5 August, 2003 Modified : 22 August, 2006 by Aarne Ranta ************************************************************** -} module CFtoFlex (cf2flex) where import CF import RegToFlex import Utils((+++), (++++)) import NamedVariables import Data.List import STLUtils --The environment must be returned for the parser to use. cf2flex :: Maybe String -> String -> CF -> (String, SymEnv) cf2flex inPackage name cf = (unlines [ prelude inPackage name, cMacros, lexSymbols env, restOfFlex inPackage cf env' ], env') where env = makeSymEnv (symbols cf ++ reservedWords cf) (0 :: Int) env' = env ++ (makeSymEnv (fst (unzip (tokenPragmas cf))) (length env)) makeSymEnv [] _ = [] makeSymEnv (s:symbs) n = (s, nsDefine inPackage "_SYMB_" ++ (show n)) : (makeSymEnv symbs (n+1)) prelude :: Maybe String -> String -> String prelude inPackage name = unlines [ maybe "" (\ns -> "%option prefix=\"" ++ ns ++ "yy\"") inPackage, "/* This FLex file was machine-generated by the BNF converter */", "%{", "#include ", "#include \"Parser.H\"", "#define YY_BUFFER_LENGTH 4096", "extern int " ++ nsString inPackage ++ "yy_mylinenumber ;", --- hack to get line number. AR 2006 "static char YY_PARSED_STRING[YY_BUFFER_LENGTH];", "static void YY_BUFFER_APPEND(char *s)", "{", " strcat(YY_PARSED_STRING, s); //Do something better here!", "}", "static void YY_BUFFER_RESET(void)", "{", " for(int x = 0; x < YY_BUFFER_LENGTH; x++)", " YY_PARSED_STRING[x] = 0;", "}", "", "%}" ] --For now all categories are included. --Optimally only the ones that are used should be generated. cMacros :: String cMacros = unlines [ "LETTER [a-zA-Z]", "CAPITAL [A-Z]", "SMALL [a-z]", "DIGIT [0-9]", "IDENT [a-zA-Z0-9'_]", "%START YYINITIAL COMMENT CHAR CHARESC CHAREND STRING ESCAPED", "%%" ] lexSymbols :: SymEnv -> String lexSymbols ss = concatMap transSym ss where transSym (s,r) = "\"" ++ s' ++ "\" \t return " ++ r ++ ";\n" where s' = escapeChars s restOfFlex :: Maybe String -> CF -> SymEnv -> String restOfFlex inPackage cf env = concat [ lexComments inPackage (comments cf), userDefTokens, ifC "String" strStates, ifC "Char" chStates, ifC "Double" ("{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t " ++ ns ++ "yylval.double_ = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";\n"), ifC "Integer" ("{DIGIT}+ \t " ++ ns ++ "yylval.int_ = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";\n"), ifC "Ident" ("{LETTER}{IDENT}* \t " ++ ns ++ "yylval.string_ = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";\n"), "\\n ++" ++ ns ++ "yy_mylinenumber ;\n", "[ \\t\\r\\n\\f] \t /* ignore white space. */;\n", ". \t return " ++ nsDefine inPackage "_ERROR_" ++ ";\n", "%%\n", footer ] where ifC cat s = if isUsedCat cf cat then s else "" ns = nsString inPackage userDefTokens = unlines $ ["" ++ printRegFlex exp ++ " \t " ++ ns ++ "yylval.string_ = strdup(yytext); return " ++ sName name ++ ";" | (name, exp) <- tokenPragmas cf] where sName n = case lookup n env of Just x -> x Nothing -> n strStates = unlines --These handle escaped characters in Strings. [ "\"\\\"\" \t BEGIN STRING;", "\\\\ \t BEGIN ESCAPED;", "\\\" \t " ++ ns ++ "yylval.string_ = strdup(YY_PARSED_STRING); YY_BUFFER_RESET(); BEGIN YYINITIAL; return " ++ nsDefine inPackage "_STRING_" ++ ";", ". \t YY_BUFFER_APPEND(yytext);", "n \t YY_BUFFER_APPEND(\"\\n\"); BEGIN STRING;", "\\\" \t YY_BUFFER_APPEND(\"\\\"\"); BEGIN STRING ;", "\\\\ \t YY_BUFFER_APPEND(\"\\\\\"); BEGIN STRING;", "t \t YY_BUFFER_APPEND(\"\\t\"); BEGIN STRING;", ". \t YY_BUFFER_APPEND(yytext); BEGIN STRING;" ] chStates = unlines --These handle escaped characters in Chars. [ "\"'\" \tBEGIN CHAR;", "\\\\ \t BEGIN CHARESC;", "[^'] \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";", "n \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = '\\n'; return " ++ nsDefine inPackage "_CHAR_" ++ ";", "t \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = '\\t'; return " ++ nsDefine inPackage "_CHAR_" ++ ";", ". \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";", "\"'\" \t BEGIN YYINITIAL;" ] footer = unlines [ "int " ++ ns ++ "initialize_lexer(FILE *inp) { yyin = inp; BEGIN YYINITIAL; }", "int yywrap(void) { return 1; }" ] lexComments :: Maybe String -> ([(String, String)], [String]) -> String lexComments inPackage (m,s) = (unlines (map (lexSingleComment inPackage) s)) ++ (unlines (map (lexMultiComment inPackage) m)) lexSingleComment :: Maybe String -> String -> String lexSingleComment inPackage c = "\"" ++ c ++ "\"[^\\n]*\\n ++" ++ nsString inPackage ++ "yy_mylinenumber ; \t /* BNFC single-line comment */;" --There might be a possible bug here if a language includes 2 multi-line comments. --They could possibly start a comment with one character and end it with another. --However this seems rare. lexMultiComment :: Maybe String -> (String, String) -> String lexMultiComment inPackage (b,e) = unlines [ "\"" ++ b ++ "\" \t BEGIN COMMENT;", "\"" ++ e ++ "\" \t BEGIN YYINITIAL;", ". \t /* BNFC multi-line comment */;", "[\\n] ++" ++ nsString inPackage ++ "yy_mylinenumber ; \t /* BNFC multi-line comment */;" ---- "\\n ++yy_mylinenumber ;" ] --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) escapeChars (x:xs) = x : (escapeChars xs) BNFC-2.6.0.3/src/formats/cpp/CPPTop.hs0000644000000000000000000001517512100475635015257 0ustar0000000000000000{- BNF Converter: C++ Main file Copyright (C) 2004 Author: Markus Forsberg, Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CPPTop (makeCPP) where import Utils import CF import CFtoCPPAbs import CFtoFlex import CFtoBison import CFtoCVisitSkel import CFtoCPPPrinter import CFtoLatex import Data.Char import System.Exit (exitFailure) makeCPP :: Bool -> String -> CF -> IO () makeCPP make name cf = do let (hfile, cfile) = cf2CPPAbs name cf writeFileRep "Absyn.H" hfile writeFileRep "Absyn.C" cfile let (flex, env) = cf2flex Nothing name cf writeFileRep (name ++ ".l") flex putStrLn " (Tested with flex 2.5.31)" let bison = cf2Bison name cf env writeFileRep (name ++ ".y") bison putStrLn " (Tested with bison 1.875a)" let header = mkHeaderFile cf (allCats cf) (allEntryPoints cf) env writeFileRep "Parser.H" header let (skelH, skelC) = cf2CVisitSkel cf writeFileRep "Skeleton.H" skelH writeFileRep "Skeleton.C" skelC let (prinH, prinC) = cf2CPPPrinter cf writeFileRep "Printer.H" prinH writeFileRep "Printer.C" prinC writeFileRep "Test.C" (cpptest cf) let latex = cfToLatex name cf writeFileRep (name ++ ".tex") latex if make then (writeFileRep "Makefile" $ makefile name) else return () makefile :: String -> String makefile name = unlines [ "CC = g++", "CCFLAGS = -g", "FLEX = flex", "BISON = bison", "LATEX = latex", "DVIPS = dvips", "", "all: Test" ++ name ++ " " ++ name ++ ".ps", "", "clean:", -- peteg: don't nuke what we generated - move that to the "vclean" target. "\trm -f *.o " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps Test" ++ name, "", "distclean:", "\t rm -f *.o Absyn.C Absyn.H Test.C Parser.C Parser.H Lexer.C Skeleton.C Skeleton.H Printer.C Printer.H " ++ name ++ ".l " ++ name ++ ".y " ++ name ++ ".tex " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps Test" ++ name ++ " Makefile", "", "Test" ++ name ++ ": Absyn.o Lexer.o Parser.o Printer.o Test.o", "\t@echo \"Linking Test" ++ name ++ "...\"", "\t${CC} ${CCFLAGS} *.o -o Test" ++ name ++ "", " ", "Absyn.o: Absyn.C Absyn.H", "\t${CC} ${CCFLAGS} -c Absyn.C", "", "Lexer.C: " ++ name ++ ".l", "\t${FLEX} -oLexer.C " ++ name ++ ".l", "", "Parser.C: " ++ name ++ ".y", "\t${BISON} " ++ name ++ ".y -o Parser.C", "", "Lexer.o: Lexer.C Parser.H", "\t${CC} ${CCFLAGS} -c Lexer.C ", "", "Parser.o: Parser.C Absyn.H", "\t${CC} ${CCFLAGS} -c Parser.C", "", "Printer.o: Printer.C Printer.H Absyn.H", "\t${CC} ${CCFLAGS} -c Printer.C", "", "Test.o: Test.C Parser.H Printer.H Absyn.H", "\t${CC} ${CCFLAGS} -c Test.C", "", "" ++ name ++ ".dvi: " ++ name ++ ".tex", "\t${LATEX} " ++ name ++ ".tex", "", "" ++ name ++ ".ps: " ++ name ++ ".dvi", "\t${DVIPS} " ++ name ++ ".dvi -o " ++ name ++ ".ps", "" ] cpptest :: CF -> String cpptest cf = unlines [ "/*** Compiler Front-End Test automatically generated by the BNF Converter ***/", "/* */", "/* This test will parse a file, print the abstract syntax tree, and then */", "/* pretty-print the result. */", "/* */", "/****************************************************************************/", "#include ", "#include \"Parser.H\"", "#include \"Printer.H\"", "#include \"Absyn.H\"", "", "int main(int argc, char ** argv)", "{", " FILE *input;", " if (argc > 1) ", " {", " input = fopen(argv[1], \"r\");", " if (!input)", " {", " fprintf(stderr, \"Error opening input file.\\n\");", " exit(1);", " }", " }", " else input = stdin;", " /* The default entry point is used. For other options see Parser.H */", " " ++ def ++ " *parse_tree = p" ++ def ++ "(input);", " if (parse_tree)", " {", " printf(\"\\nParse Succesful!\\n\");", " printf(\"\\n[Abstract Syntax]\\n\");", " ShowAbsyn *s = new ShowAbsyn();", " printf(\"%s\\n\\n\", s->show(parse_tree));", " printf(\"[Linearized Tree]\\n\");", " PrintAbsyn *p = new PrintAbsyn();", " printf(\"%s\\n\\n\", p->print(parse_tree));", " return 0;", " }", " return 1;", "}", "" ] where def = head (allEntryPoints cf) mkHeaderFile cf cats eps env = unlines [ "#ifndef PARSER_HEADER_FILE", "#define PARSER_HEADER_FILE", "", concatMap mkForwardDec cats, "typedef union", "{", " int int_;", " char char_;", " double double_;", " char* string_;", (concatMap mkVar cats) ++ "} YYSTYPE;", "", "#define _ERROR_ 258", mkDefines (259 :: Int) env, "extern YYSTYPE yylval;", concatMap mkFunc eps, "", "#endif" ] where mkForwardDec s | (normCat s == s) = "class " ++ (identCat s) ++ ";\n" mkForwardDec _ = "" mkVar s | (normCat s == s) = " " ++ (identCat s) ++"*" +++ (map toLower (identCat s)) ++ "_;\n" mkVar _ = "" mkDefines n [] = mkString n mkDefines n ((_,s):ss) = ("#define " ++ s +++ (show n) ++ "\n") ++ (mkDefines (n+1) ss) mkString n = if isUsedCat cf "String" then ("#define _STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) else mkChar n mkChar n = if isUsedCat cf "Char" then ("#define _CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) else mkInteger n mkInteger n = if isUsedCat cf "Integer" then ("#define _INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) else mkDouble n mkDouble n = if isUsedCat cf "Double" then ("#define _DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) else mkIdent n mkIdent n = if isUsedCat cf "Ident" then ("#define _IDENT_ " ++ show n ++ "\n") else "" mkFunc s | (normCat s == s) = (identCat s) ++ "*" +++ "p" ++ (identCat s) ++ "(FILE *inp);\n" mkFunc _ = "" BNFC-2.6.0.3/src/formats/cpp/CFtoBison.hs0000644000000000000000000002573712100475635016005 0ustar0000000000000000{- BNF Converter: Bison generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- BNF Converter: C++ Bison generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Bison input file. Note that because of the way bison stores results the programmer can increase performance by limiting the number of entry points in their grammar. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 6 August, 2003 Modified : 6 August, 2003 ************************************************************** -} module CFtoBison (cf2Bison) where import CF import Data.List (intersperse, isPrefixOf) import NamedVariables hiding (varName) import Data.Char (toLower,isUpper) import Utils ((+++), (++++)) import TypeChecker import ErrM --This follows the basic structure of CFtoHappy. -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String --The environment comes from the CFtoFlex cf2Bison :: String -> CF -> SymEnv -> String cf2Bison name cf env = unlines [header name cf, union (allCats cf), "%token _ERROR_", tokens user env, declarations cf, specialToks cf, "%%", prRules (rulesForBison name cf env) ] where user = fst (unzip (tokenPragmas cf)) header :: String -> CF -> String header name cf = unlines ["/* This Bison file was machine-generated by BNFC */", "%{", "#include ", "#include ", "#include ", "#include ", "#include \"Absyn.H\"", "int yyparse(void);", "int yylex(void);", "int yy_mylinenumber;", --- hack to get line number. AR 2006 "int initialize_lexer(FILE * inp);", "int yywrap(void)", "{", " return 1;", "}", "void yyerror(const char *str)", "{", " std::cout << \"line \" << yy_mylinenumber + 1 << std::endl ;", " fprintf(stderr,\"error: %s\\n\",str);", "}", "", definedRules cf, unlines $ map (parseMethod name) (allCatsIdNorm cf), -- (allEntryPoints cf), M.F. 2004-09-14 fix of [Ty2] bug. concatMap reverseList (filter isList (allCats cf)), "%}" ] definedRules :: CF -> String definedRules cf = unlines [ rule f xs e | FunDef f xs e <- pragmasOfCF cf] where ctx = buildContext cf list = LC (const "[]") (\t -> "List" ++ unBase t) where unBase (ListT t) = unBase t unBase (BaseT x) = normCat x rule f xs e = case checkDefinition' list ctx f xs e of Bad err -> error $ "Panic! This should have been caught already:\n" ++ err Ok (args,(e',t)) -> unlines [ cppType t ++ " " ++ f ++ "_ (" ++ concat (intersperse ", " $ map cppArg args) ++ ") {" , " return " ++ cppExp e' ++ ";" , "}" ] where cppType :: Base -> String cppType (ListT (BaseT x)) = "List" ++ normCat x ++ " *" cppType (ListT t) = cppType t ++ " *" cppType (BaseT x) | isToken x ctx = "String" | otherwise = normCat x ++ " *" cppArg :: (String, Base) -> String cppArg (x,t) = cppType t ++ " " ++ x ++ "_" cppExp :: Exp -> String cppExp (App "[]" []) = "0" cppExp (App x []) | elem x xs = x ++ "_" -- argument cppExp (App t [e]) | isToken t ctx = cppExp e cppExp (App x es) | isUpper (head x) = call ("new " ++ x) es | otherwise = call (x ++ "_") es cppExp (LitInt n) = show n cppExp (LitDouble x) = show x cppExp (LitChar c) = show c cppExp (LitString s) = show s call x es = x ++ "(" ++ concat (intersperse ", " $ map cppExp es) ++ ")" --This generates a parser method for each entry point. parseMethod :: String -> Cat -> String parseMethod name cat = -- if normCat cat /= cat M.F. 2004-09-17 comment. No duplicates from allCatsIdNorm -- then "" -- else unlines [ cat' ++ "*" +++ (resultName cat') +++ "= 0;", cat' ++"* p" ++ cat' ++ "(FILE *inp)", "{", " initialize_lexer(inp);", " if (yyparse())", " { /* Failure */", " return 0;", " }", " else", " { /* Success */", " return" +++ (resultName cat') ++ ";", " }", "}" ] where cat' = identCat (normCat cat) --This method generates list reversal functions for each list type. reverseList :: Cat -> String reverseList c = unlines [ c' ++ "* reverse" ++ c' ++ "(" ++ c' +++ "*l)", "{", " " ++ c' +++"*prev = 0;", " " ++ c' +++"*tmp = 0;", " while (l)", " {", " tmp = l->" ++ v ++ ";", " l->" ++ v +++ "= prev;", " prev = l;", " l = tmp;", " }", " return prev;", "}" ] where c' = identCat (normCat c) v = (map toLower c') ++ "_" --The union declaration is special to Bison/Yacc and gives the type of yylval. --For efficiency, we may want to only include used categories here. union :: [Cat] -> String union cats = unlines [ "%union", "{", " int int_;", " char char_;", " double double_;", " char* string_;", concatMap mkPointer cats, "}" ] where --This is a little weird because people can make [Exp2] etc. mkPointer s | identCat s /= s = --list. add it even if it refers to a coercion. " " ++ (identCat (normCat s)) ++ "*" +++ (varName (normCat s)) ++ ";\n" mkPointer s | normCat s == s = --normal cat " " ++ (identCat (normCat s)) ++ "*" +++ (varName (normCat s)) ++ ";\n" mkPointer s = "" --declares non-terminal types. declarations :: CF -> String declarations cf = concatMap (typeNT cf) (allCats cf) where --don't define internal rules typeNT cf nt | rulesForCat cf nt /= [] = "%type <" ++ (varName (normCat nt)) ++ "> " ++ (identCat nt) ++ "\n" typeNT cf nt = "" --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user ts = concatMap (declTok user) ts where declTok u (s,r) = if elem s u then "%token " ++ r ++ " // " ++ s ++ "\n" else "%token " ++ r ++ " // " ++ s ++ "\n" specialToks :: CF -> String specialToks cf = concat [ ifC "String" "%token _STRING_\n", ifC "Char" "%token _CHAR_\n", ifC "Integer" "%token _INTEGER_\n", ifC "Double" "%token _DOUBLE_\n", ifC "Ident" "%token _IDENT_\n" ] where ifC cat s = if isUsedCat cf cat then s else "" --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForBison :: String -> CF -> SymEnv -> Rules rulesForBison name cf env = map mkOne $ ruleGroups cf where mkOne (cat,rules) = constructRule cf env rules cat -- For every non-terminal, we construct a set of rules. constructRule :: CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule cf env rules nt = (nt,[(p,(generateAction (ruleName r) b m) +++ result) | r0 <- rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True,revSepListRule r0) else (False,r0), let (p,m) = generatePatterns cf env r]) where ruleName r = case funRule r of "(:)" -> identCat nt "(:[])" -> identCat nt z -> z revs = reversibleCats cf eps = allEntryPoints cf isEntry nt = if elem nt eps then True else False result = if isEntry nt then (resultName (normCat (identCat nt))) ++ "= $$;" else "" -- Generates a string containing the semantic action. generateAction :: Fun -> Bool -> [MetaVar] -> Action generateAction f b ms = if isCoercion f then (unwords ms) ++ ";" else if f == "[]" then "0;" else if isDefinedRule f then concat [ f, "_", "(", concat $ intersperse ", " ms', ");" ] else concat ["new ", normCat f, "(", (concat (intersperse ", " ms')), ");"] where ms' = if b then reverse ms else ms -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: CF -> SymEnv -> Rule -> (Pattern,[MetaVar]) generatePatterns cf env r = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> case lookup c env of Just x -> x Nothing -> typeName (identCat c) Right s -> case lookup s env of Just x -> x Nothing -> s metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 :: Int ..] its] revIf c m = if (not (isConsFun (funRule r)) && elem c revs) then ("reverse" ++ (identCat (normCat c)) ++ "(" ++ m ++ ")") else m -- no reversal in the left-recursive Cons rule itself revs = reversibleCats cf -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. prRules :: Rules -> String prRules [] = [] prRules ((nt, []):rs) = prRules rs --internal rule prRules ((nt,((p,a):ls)):rs) = (unwords [nt', ":" , p, "{ $$ =", a, "}", "\n" ++ pr ls]) ++ ";\n" ++ prRules rs where nt' = identCat nt pr [] = [] pr ((p,a):ls) = (unlines [(concat $ intersperse " " [" |", p, "{ $$ =", a , "}"])]) ++ pr ls --Some helper functions. resultName :: String -> String resultName s = "YY_RESULT_" ++ s ++ "_" --slightly stronger than the NamedVariable version. varName :: String -> String varName s = (map toLower (identCat s)) ++ "_" typeName :: String -> String typeName "Ident" = "_IDENT_" typeName "String" = "_STRING_" typeName "Char" = "_CHAR_" typeName "Integer" = "_INTEGER_" typeName "Double" = "_DOUBLE_" typeName x = x BNFC-2.6.0.3/src/formats/cpp/RegToFlex.hs0000644000000000000000000000443312100475635016004 0ustar0000000000000000module RegToFlex (printRegFlex) where -- modified from pretty-printer generated by the BNF converter import AbsBNF import Data.Char -- the top-level printing method printRegFlex :: Reg -> String printRegFlex = render . prt 0 -- you may want to change render and parenth render :: [String] -> String render = rend (0::Int) where rend i ss = case ss of "[" :ts -> cons "[" $ rend i ts "(" :ts -> cons "(" $ rend i ts t : "," :ts -> cons t $ space "," $ rend i ts t : ")" :ts -> cons t $ cons ")" $ rend i ts t : "]" :ts -> cons t $ cons "]" $ rend i ts t :ts -> space t $ rend i ts _ -> "" cons s t = s ++ t new i s = s space t s = if null s then t else t ++ s parenth :: [String] -> [String] parenth ss = ["("] ++ ss ++ [")"] -- the printer class does the job class Print a where prt :: Int -> a -> [String] prtList :: [a] -> [String] prtList = concat . map (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = [[c]] prtList s = map (concat . prt 0) s prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (concat [prt 2 reg0 , prt 3 reg]) RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg]) RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg]) RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]]) RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]]) ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]]) REps -> prPrec i 3 (["[^.]"]) RChar c -> prPrec i 3 (prt 0 [mkEsc [c]]) RAlts str -> prPrec i 3 (concat [["["], prt 0 $ mkEsc str, ["]"]]) RSeqs str -> prPrec i 2 (concat (map (prt 0) $ mkEsc str)) RDigit -> prPrec i 3 (concat [["{DIGIT}"]]) RLetter -> prPrec i 3 (concat [["{LETTER}"]]) RUpper -> prPrec i 3 (concat [["{CAPITAL}"]]) RLower -> prPrec i 3 (concat [["{SMALL}"]]) RAny -> prPrec i 3 (concat [["."]]) -- Handle special characters in regular expressions. mkEsc :: String -> String mkEsc = concatMap escChar where escChar c | c `elem` "$+-*=<>[](){}!?.,;:^~|&%#/\\$_@\"" = '\\':[c] | otherwise = [c] BNFC-2.6.0.3/src/formats/cpp/CFtoCPPAbs.hs0000644000000000000000000003206212100475635015770 0ustar0000000000000000{- BNF Converter: C++ abstract syntax generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C++ Abstract Syntax tree classes. It generates both a Header file and an Implementation file, and uses the Visitor design pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 4 August, 2003 Modified : 22 May, 2004 / Antti-Juhani Kaijanaho ************************************************************** -} module CFtoCPPAbs (cf2CPPAbs) where import CF import Utils((+++),(++++)) import NamedVariables import Data.List import Data.Char(toLower) --The result is two files (.H file, .C file) cf2CPPAbs :: String -> CF -> (String, String) cf2CPPAbs name cf = (mkHFile cf, mkCFile cf) {- **** Header (.H) File Functions **** -} --Makes the Header file. mkHFile :: CF -> String mkHFile cf = unlines [ "#ifndef ABSYN_HEADER", "#define ABSYN_HEADER", "", header, prTypeDefs user, "/******************** Forward Declarations ********************/\n", concatMap prForward classes, "", prVisitor classes, prVisitable, "", "/******************** Abstract Syntax Classes ********************/\n", concatMap (prDataH user) (cf2dataLists cf), "", "#endif" ] where user = fst (unzip (tokenPragmas cf)) header = "//C++ Abstract Syntax Interface generated by the BNF Converter.\n" rules = getRules cf classes = rules ++ (getClasses (allCats cf)) prForward s | isProperLabel s = "class " ++ (normCat s) ++ ";\n" prForward s = "" getRules cf = (map testRule (rulesOfCF cf)) getClasses [] = [] getClasses (c:cs) = if identCat (normCat c) /= c then getClasses cs else if elem c rules then getClasses cs else c : (getClasses cs) testRule (Rule f c r) = if isList c then if isConsFun f then identCat c else "_" --ignore this else f --Prints interface classes for all categories. prDataH :: [UserDef] -> Data -> String prDataH user (cat, rules) = case lookup cat rules of Just x -> concatMap (prRuleH user cat) rules Nothing -> if isList cat then concatMap (prRuleH user cat) rules else unlines [ "class" +++ (identCat cat) +++ ": public Visitable {", "public:", " virtual" +++ (identCat cat) +++ "*clone() const = 0;", "};\n", concatMap (prRuleH user cat) rules ] --Interface definitions for rules vary on the type of rule. prRuleH :: [UserDef] -> String -> (Fun, [Cat]) -> String prRuleH user c (fun, cats) = if isNilFun fun || isOneFun fun then "" --these are not represented in the AbSyn else if isConsFun fun then --this is the linked list case. unlines [ "class" +++ c' +++ ": public Visitable", "{", " public:", prInstVars user vs, " " ++ c' ++ "(const" +++ c' +++ "&);", " " ++ c' ++ " &operator=(const" +++ c' +++ "&);", " " ++ c' ++ "(" ++ (prConstructorH 1 vs) ++ ");", " " ++ c' ++ "(" ++ mem +++ memstar ++ "p);", prDestructorH c', " " ++ c' ++ "* reverse();", " " ++ c' ++ "* reverse(" ++ c' ++ " *l);", " virtual void accept(Visitor *v);", " virtual " ++ c' ++ " *clone() const;", " void swap(" ++ c' +++ "&);", "};" ] else --a standard rule unlines [ "class" +++ fun' +++ ": public" +++ super, "{", " public:", prInstVars user vs, " " ++ fun' ++ "(const" +++ fun' +++ "&);", " " ++ fun' ++ " &operator=(const" +++ fun' +++ "&);", " " ++ fun' ++ "(" ++ (prConstructorH 1 vs) ++ ");", prDestructorH fun', " virtual void accept(Visitor *v);", " virtual " +++ fun' +++ " *clone() const;", " void swap(" ++ fun' +++ "&);", "};\n" ] where vs = getVars cats fun' = identCat (normCat fun) c' = identCat (normCat c); mem = drop 4 c' memstar = if isBasic user mem then "" else "*" super = if c == fun then "Visitable" else (identCat c) prConstructorH :: Int -> [(String, b)] -> String prConstructorH _ [] = "" prConstructorH n ((t,_):[]) = t +++ (optstar t) ++ "p" ++ (show n) prConstructorH n ((t,_):vs) =( t +++ (optstar t) ++ "p" ++ (show n) ++ ", ") ++ (prConstructorH (n+1) vs) prDestructorH n = " ~" ++ n ++ "();" optstar x = if isBasic user x then "" else "*" prVisitable :: String prVisitable = unlines [ "class Visitable", "{", " public:", -- all classes with virtual methods require a virtual destructor " virtual ~Visitable() {}", " virtual void accept(Visitor *v) = 0;", "};\n" ] prVisitor :: [String] -> String prVisitor fs = unlines [ "/******************** Visitor Interfaces ********************/", "", "class Visitor", "{", " public:", " virtual ~Visitor() {}", (concatMap (prVisitFun) fs), footer ] where footer = unlines [ --later only include used categories " virtual void visitInteger(Integer i) = 0;", " virtual void visitDouble(Double d) = 0;", " virtual void visitChar(Char c) = 0;", " virtual void visitString(String s) = 0;", "};" ] prVisitFun f | isProperLabel f = " virtual void visit" ++ f' ++ "(" ++ f' ++ " *p) = 0;\n" where f' = identCat (normCat f) prVisitFun _ = "" --typedefs in the Header make generation much nicer. prTypeDefs user = unlines [ "/******************** TypeDef Section ********************/", "typedef int Integer;", "typedef char Char;", "typedef double Double;", "typedef char* String;", "typedef char* Ident;", concatMap prUserDef user ] where prUserDef s = "typedef char* " ++ s ++ ";\n" --A class's instance variables. prInstVars :: [UserDef] -> [IVar] -> String prInstVars _ [] = [] prInstVars user vars@((t,n):vs) = " " ++ t +++ uniques ++ ";" ++++ (prInstVars user vs') where (uniques, vs') = prUniques t vars --these functions group the types together nicely prUniques :: String -> [IVar] -> (String, [IVar]) prUniques t vs = (prVars (findIndices (\x -> case x of (y,_) -> y == t) vs) vs, remType t vs) prVars (x:[]) vs = case vs !! x of (t,n) -> ((varLinkName t) ++ (showNum n)) prVars (x:xs) vs = case vs !! x of (t,n) -> ((varLinkName t) ++ (showNum n)) ++ "," +++ (prVars xs vs) varLinkName z = if isBasic user z then (map toLower z) ++ "_" else "*" ++ (map toLower z) ++ "_" remType :: String -> [IVar] -> [IVar] remType _ [] = [] remType t ((t2,n):ts) = if t == t2 then (remType t ts) else (t2,n) : (remType t ts) {- **** Implementation (.C) File Functions **** -} --Makes the .C file mkCFile :: CF -> String mkCFile cf = unlines [ header, concatMap (prDataC user) (cf2dataLists cf) ] where user = fst (unzip (tokenPragmas cf)) header = unlines [ "//C++ Abstract Syntax Implementation generated by the BNF Converter.", "#include ", "#include \"Absyn.H\"" ] --This is not represented in the implementation. prDataC :: [UserDef] -> Data -> String prDataC user (cat, rules) = concatMap (prRuleC user cat) rules --Classes for rules vary based on the type of rule. prRuleC user c (fun, cats) = if isNilFun fun || isOneFun fun then "" --these are not represented in the AbSyn else if isConsFun fun then --this is the linked list case. unlines [ "/******************** " ++ c' ++ " ********************/", prConstructorC user c' vs cats, prCopyC user c' vs, prDestructorC user c' vs, prListFuncs user c', prAcceptC c', prCloneC user c' vs, "" ] else --a standard rule unlines [ "/******************** " ++ fun' ++ " ********************/", prConstructorC user fun' vs cats, prCopyC user fun' vs, prDestructorC user fun' vs, prAcceptC fun, prCloneC user fun' vs, "" ] where vs = getVars cats fun' = identCat (normCat fun) c' = identCat (normCat c) --These are all built-in list functions. --Later we could include things like lookup,insert,delete,etc. prListFuncs :: [UserDef] -> String -> String prListFuncs user c = unlines [ c ++ "::" ++ c ++ "(" ++ m +++ mstar ++ "p)", "{", " " ++ m' ++ " = p;", " " ++ v ++ "= 0;", "}", c ++ "*" +++ c ++ "::" ++ "reverse()", "{", " if (" ++ v +++ "== 0) return this;", " else", " {", " " ++ c ++ " *tmp =" +++ v ++ "->reverse(this);", " " ++ v +++ "= 0;", " return tmp;", " }", "}", "", c ++ "*" +++ c ++ "::" ++ "reverse(" ++ c ++ "* prev)", "{", " if (" ++ v +++ "== 0)", " {", " " ++ v +++ "= prev;", " return this;", " }", " else", " {", " " ++ c +++ "*tmp =" +++ v ++ "->reverse(this);", " " ++ v +++ "= prev;", " return tmp;", " }", "}" ] where v = (map toLower c) ++ "_" m = drop 4 c mstar = if isBasic user m then "" else "*" m' = drop 4 v --The standard accept function for the Visitor pattern prAcceptC :: String -> String prAcceptC ty = "\nvoid " ++ ty ++ "::accept(Visitor *v) { v->visit" ++ ty ++ "(this); }" --The constructor just assigns the parameters to the corresponding instance variables. prConstructorC :: [UserDef] -> String -> [IVar] -> [Cat] -> String prConstructorC user c vs cats = c ++ "::" ++ c ++"(" ++ (interleave types params) ++ ")" +++ "{" +++ prAssigns vs params ++ "}" where (types, params) = unzip (prParams cats (length cats) ((length cats)+1)) interleave _ [] = [] interleave (x:[]) (y:[]) = x +++ (optstar x) ++ y interleave (x:xs) (y:ys) = x +++ (optstar x) ++ y ++ "," +++ (interleave xs ys) optstar x = if isBasic user x then "" else "*" --Print copy constructor and copy assignment prCopyC :: [UserDef] -> String -> [IVar] -> String prCopyC user c vs = c ++ "::" ++ c ++ "(const" +++ c +++ "& other) {" +++ concatMap doV vs ++++ "}" ++++ c +++ "&" ++ c ++ "::" ++ "operator=(const" +++ c +++ "& other) {" ++++ " " ++ c +++ "tmp(other);" ++++ " swap(tmp);" ++++ " return *this;" ++++ "}" ++++ "void" +++ c ++ "::swap(" ++ c +++ "& other) {" ++++ concatMap swapV vs ++++ "}\n" where doV :: IVar -> String doV v@(t, _) | isBasic user t = " " ++ vn v ++ " = other." ++ vn v ++ ";\n" | otherwise = " " ++ vn v ++ " = other." ++ vn v ++ "->clone();\n" vn :: IVar -> String vn (t, 0) = varName t vn (t, n) = varName t ++ show n swapV :: IVar -> String swapV v = " std::swap(" ++ vn v ++ ", other." ++ vn v ++ ");\n" --The cloner makes a new deep copy of the object prCloneC :: [UserDef] -> String -> [IVar] -> String prCloneC user c vs = c +++ "*" ++ c ++ "::clone() const {" ++++ " return new" +++ c ++ "(*this);\n}" --The destructor deletes all a class's members. prDestructorC :: [UserDef] -> String -> [IVar] -> String prDestructorC user c vs = c ++ "::~" ++ c ++"()" +++ "{" +++ (concatMap prDeletes vs) ++ "}" where prDeletes :: (String, Int) -> String prDeletes (t, n) = if isBasic user t then "" else if n == 0 then "delete(" ++ (varName t) ++ "); " else "delete(" ++ (varName t) ++ (show n) ++ "); " --Prints the constructor's parameters. prParams :: [Cat] -> Int -> Int -> [(String,String)] prParams [] _ _ = [] prParams (c:cs) n m = (identCat c,"p" ++ (show (m-n))) : (prParams cs (n-1) m) --Prints the assignments of parameters to instance variables. --This algorithm peeks ahead in the list so we don't use map or fold prAssigns :: [IVar] -> [String] -> String prAssigns [] _ = [] prAssigns _ [] = [] prAssigns ((t,n):vs) (p:ps) = if n == 1 then case findIndices (\x -> case x of (l,r) -> l == t) vs of [] -> (varName t) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) z -> ((varName t) ++ (showNum n)) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) else ((varName t) ++ (showNum n)) +++ "=" +++ p ++ ";" +++ (prAssigns vs ps) {- **** Helper Functions **** -} --Checks if something is a basic or user-defined type. isBasic :: [UserDef] -> String -> Bool isBasic user x = if elem x user then True else case x of "Integer" -> True "Char" -> True "String" -> True "Double" -> True "Ident" -> True _ -> False BNFC-2.6.0.3/src/formats/cpp/CFtoCPPPrinter.hs0000644000000000000000000004023212100475635016704 0ustar0000000000000000{- ************************************************************** BNF Converter Module Description : This module generates the C++ Pretty Printer. It also generates the "show" method for printing an abstract syntax tree. The generated files use the Visitor design pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 10 August, 2003 Modified : 3 September, 2003 * Added resizable buffers ************************************************************** -} module CFtoCPPPrinter (cf2CPPPrinter) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper) --Produces (.H file, .C file) cf2CPPPrinter :: CF -> (String, String) cf2CPPPrinter cf = (mkHFile cf groups, mkCFile cf groups) where groups = (fixCoercions (ruleGroupsInternals cf)) {- **** Header (.H) File Methods **** -} --An extremely large function to make the Header File mkHFile :: CF -> [(Cat,[Rule])] -> String mkHFile cf groups = unlines [ printHeader, concatMap prDataH groups, classFooter, showHeader, concatMap prDataH groups, classFooter, footer ] where printHeader = unlines [ "#ifndef PRINTER_HEADER", "#define PRINTER_HEADER", "", "#include \"Absyn.H\"", "#include ", "#include ", "#include ", "", "/* Certain applications may improve performance by changing the buffer size */", "#define BUFFER_INITIAL 2000", "/* You may wish to change _L_PAREN or _R_PAREN */", "#define _L_PAREN '('", "#define _R_PAREN ')'", "", "class PrintAbsyn : public Visitor", "{", " protected:", " int _n_, _i_;", " /* The following are simple heuristics for rendering terminals */", " /* You may wish to change them */", " void render(Char c);", " void render(String s);", " void indent(void);", " void backup(void);", " public:", " PrintAbsyn(void);", " ~PrintAbsyn(void);", " char* print(Visitable* v);" ] classFooter = unlines [ " void visitInteger(Integer i);", " void visitDouble(Double d);", " void visitChar(Char c);", " void visitString(String s);", " void visitIdent(String s);", " protected:", " void inline bufAppend(const char* s)", " {", " int len = strlen(s);", " while (cur_ + len > buf_size)", " {", " buf_size *= 2; /* Double the buffer size */", " resizeBuffer();", " }", " for(int n = 0; n < len; n++)", " {", " buf_[cur_ + n] = s[n];", " }", " cur_ += len;", " buf_[cur_] = 0;", " }", " void inline bufAppend(const char c)", " {", " if (cur_ == buf_size)", " {", " buf_size *= 2; /* Double the buffer size */", " resizeBuffer();", " }", " buf_[cur_] = c;", " cur_++;", " buf_[cur_] = 0;", " }", " void inline bufReset(void)", " {", " cur_ = 0;", " buf_size = BUFFER_INITIAL;", " resizeBuffer();", " memset(buf_, 0, buf_size);", " }", " void inline resizeBuffer(void)", " {", " char* temp = (char*) malloc(buf_size);", " if (!temp)", " {", " fprintf(stderr, \"Error: Out of memory while attempting to grow buffer!\\n\");", " exit(1);", " }", " if (buf_)", " {", " strcpy(temp, buf_);", " free(buf_);", " }", " buf_ = temp;", " }", " char *buf_;", " int cur_, buf_size;", "};", "" ] showHeader = unlines [ "", "class ShowAbsyn : public Visitor", "{", " public:", " ShowAbsyn(void);", " ~ShowAbsyn(void);", " char* show(Visitable* v);" ] footer = unlines [ "", "#endif" ] --Prints all the required method names and their parameters. prDataH :: (Cat, [Rule]) -> String prDataH (cat, rules) = if "List" `isPrefixOf` (identCat cat) then concat [" void visit", cl, "(", cl, "* p);\n"] else abstract ++ (concatMap prRuleH rules) where cl = identCat (normCat cat) abstract = case lookupRule cat rules of Just x -> "" Nothing -> " void visit" ++ cl ++ "(" ++ cl ++ " *p); /* abstract class */\n" --Prints all the methods to visit a rule. prRuleH :: Rule -> String prRuleH (Rule fun c cats) | isProperLabel fun = concat [" void visit", fun, "(", fun, " *p);\n"] prRuleH _ = "" {- **** Implementation (.C) File Methods **** -} --This makes the .C file by a similar method. mkCFile :: CF -> [(Cat,[Rule])] -> String mkCFile cf groups = concat [ header, prRender, printEntries, concatMap (prPrintData user) groups, printBasics, showEntries, concatMap (prShowData user) groups, showBasics ] where user = fst (unzip (tokenPragmas cf)) header = unlines [ "/*** BNFC-Generated Pretty Printer and Abstract Syntax Viewer ***/", "", "#include \"Printer.H\"", "" ] printEntries = unlines [ "PrintAbsyn::PrintAbsyn(void)", "{", " _i_ = 0; _n_ = 0;", " buf_ = 0;", " bufReset();", "}", "", "PrintAbsyn::~PrintAbsyn(void)", "{", "}", "", "char* PrintAbsyn::print(Visitable *v)", "{", " _i_ = 0; _n_ = 0;", " bufReset();", " v->accept(this);", " return buf_;", "}" ] showEntries = unlines [ "ShowAbsyn::ShowAbsyn(void)", "{", " buf_ = 0;", " bufReset();", "}", "", "ShowAbsyn::~ShowAbsyn(void)", "{", "}", "", "char* ShowAbsyn::show(Visitable *v)", "{", " bufReset();", " v->accept(this);", " return buf_;", "}" ] printBasics = unlines [ "void PrintAbsyn::visitInteger(Integer i)", "{", " char tmp[16];", " sprintf(tmp, \"%d\", i);", " bufAppend(tmp);", "}", "void PrintAbsyn::visitDouble(Double d)", "{", " char tmp[16];", " sprintf(tmp, \"%g\", d);", " bufAppend(tmp);", "}", "void PrintAbsyn::visitChar(Char c)", "{", " bufAppend('\\'');", " bufAppend(c);", " bufAppend('\\'');", "}", "void PrintAbsyn::visitString(String s)", "{", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "void PrintAbsyn::visitIdent(String s)", "{", " render(s);", "}", "" ] showBasics = unlines [ "void ShowAbsyn::visitInteger(Integer i)", "{", " char tmp[16];", " sprintf(tmp, \"%d\", i);", " bufAppend(tmp);", "}", "void ShowAbsyn::visitDouble(Double d)", "{", " char tmp[16];", " sprintf(tmp, \"%g\", d);", " bufAppend(tmp);", "}", "void ShowAbsyn::visitChar(Char c)", "{", " bufAppend('\\'');", " bufAppend(c);", " bufAppend('\\'');", "}", "void ShowAbsyn::visitString(String s)", "{", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "void ShowAbsyn::visitIdent(String s)", "{", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "" ] {- **** Pretty Printer Methods **** -} --Generates methods for the Pretty Printer prPrintData :: [UserDef] -> (Cat, [Rule]) -> String prPrintData user (cat, rules) = if "List" `isPrefixOf` (identCat cat) then unlines [ "void PrintAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")", "{", " while(" ++ vname ++ "!= 0)", " {", " if (" ++ vname ++ "->" ++ vname ++ "_ == 0)", " {", visitMember, optsep, " " ++ vname +++ "= 0;", " }", " else", " {", visitMember, " render(" ++ sep ++ ");", " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", " }", "}", "" ] --Not a list: else abstract ++ (concatMap (prPrintRule user) rules) where cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl ++ "_" visitMember = if isBasic user member then " visit" ++ (funName member) ++ "(" ++ vname ++ "->" ++ member ++ ");" else " " ++ vname ++ "->" ++ member ++ "->accept(this);" sep = if (length sep') == 1 then "'" ++ (escapeChars sep') ++ "'" else "\"" ++ (escapeChars sep') ++ "\"" sep' = getCons rules optsep = if hasOneFunc rules then "" else (" render(" ++ sep ++ ");") abstract = case lookupRule cat rules of Just x -> "" Nothing -> "void PrintAbsyn::visit" ++ cl ++ "(" ++ cl ++ "*p) {} //abstract class\n\n" --Pretty Printer methods for a rule. prPrintRule :: [UserDef] -> Rule -> String prPrintRule user r@(Rule fun c cats) | isProperLabel fun = unlines [ "void PrintAbsyn::visit" ++ fun ++ "(" ++ fun ++ "*" +++ fnm ++ ")", "{", " int oldi = _i_;", lparen, cats', rparen, " _i_ = oldi;", "}\n" ] where p = precRule r (lparen, rparen) = (" if (oldi > " ++ (show p) ++ ") render(_L_PAREN);\n", " if (oldi > " ++ (show p) ++ ") render(_R_PAREN);\n") cats' = (concatMap (prPrintCat user fnm) (zip (fixOnes (numVars [] cats)) (map getPrec cats))) fnm = "p" --old names could cause conflicts getPrec (Right s) = 0 getPrec (Left c) = precCat c prPrintRule _ _ = "" --This goes on to recurse to the instance variables. prPrintCat :: [UserDef] -> String -> (Either Cat String, Int) -> String prPrintCat user fnm (c,p) = case c of (Right t) -> " render(" ++ t' ++ ");\n" where t' = if length t == 1 then "'" ++ (escapeChars t) ++ "'" else "\"" ++ (escapeChars t) ++ "\"" (Left nt) -> if isBasic user nt then " visit" ++ (funName nt) ++ "(" ++ fnm ++ "->" ++ nt ++ ");\n" else if "list" `isPrefixOf` nt then " if(" ++ fnm ++ "->" ++ nt ++ ") {" ++ accept ++ "}" else " " ++ accept ++ "\n" where accept = if nt == "#_" --Internal category then "/* Internal Category */\n" else (setI p) ++ fnm ++ "->" ++ nt ++ "->accept(this);" {- **** Abstract Syntax Tree Printer **** -} --This prints the functions for Abstract Syntax tree printing. prShowData :: [UserDef] -> (Cat, [Rule]) -> String prShowData user (cat, rules) = if "List" `isPrefixOf` (identCat cat) then unlines [ "void ShowAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")", "{", " while(" ++ vname ++ "!= 0)", " {", " if (" ++ vname ++ "->" ++ vname ++ "_)", " {", visitMember, " bufAppend(\", \");", " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", " else", " {", visitMember, " " ++ vname ++ " = 0;", " }", " }", "}", "" ] --Not a list: else abstract ++ (concatMap (prShowRule user) rules) where cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl ++ "_" visitMember = if isBasic user member then " visit" ++ (funName member) ++ "(" ++ vname ++ "->" ++ member ++ ");" else " " ++ vname ++ "->" ++ member ++ "->accept(this);" abstract = case lookupRule cat rules of Just x -> "" Nothing -> "void ShowAbsyn::visit" ++ cl ++ "(" ++ cl ++ "* p) {} //abstract class\n\n" --This prints all the methods for Abstract Syntax tree rules. prShowRule :: [UserDef] -> Rule -> String prShowRule user (Rule fun c cats) | isProperLabel fun = concat [ "void ShowAbsyn::visit" ++ fun ++ "(" ++ fun ++ "*" +++ fnm ++ ")\n", "{\n", lparen, " bufAppend(\"" ++ fun ++ "\");\n", optspace, cats', rparen, "}\n" ] where (optspace, lparen, rparen) = if allTerms cats then ("","","") else (" bufAppend(' ');\n", " bufAppend('(');\n"," bufAppend(')');\n") cats' = if allTerms cats then "" else concat (insertSpaces (map (prShowCat user fnm) (fixOnes (numVars [] cats)))) insertSpaces [] = [] insertSpaces (x:[]) = [x] insertSpaces (x:xs) = if x == "" then insertSpaces xs else (x : [" bufAppend(' ');\n"]) ++ (insertSpaces xs) allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs fnm = "p" --other names could cause conflicts prShowRule _ _ = "" --This recurses to the instance variables of a class. prShowCat :: [UserDef] -> String -> Either Cat String -> String prShowCat user fnm c = case c of (Right t) -> "" (Left nt) -> if isBasic user nt then " visit" ++ (funName nt) ++ "(" ++ fnm ++ "->" ++ nt ++ ");\n" else if nt == "#_" --internal category then "/* Internal Category */\n" else if ((normCat nt) /= nt) then accept else concat [ " bufAppend('[');\n", " if (" ++ fnm ++ "->" ++ nt ++ ")" ++ accept, " bufAppend(']');\n" ] where accept = " " ++ fnm ++ "->" ++ nt ++ "->accept(this);\n" {- **** Helper Functions Section **** -} --Just checks if something is a basic or user-defined type. --This is because you don't -> a basic non-pointer type. isBasic :: [UserDef] -> String -> Bool isBasic user v = if elem (init v) user' then True else if "integer_" `isPrefixOf` v then True else if "char_" `isPrefixOf` v then True else if "string_" `isPrefixOf` v then True else if "double_" `isPrefixOf` v then True else if "ident_" `isPrefixOf` v then True else False where user' = map (map toLower) user --The visit-function name of a basic type funName :: String -> String funName v = if "integer_" `isPrefixOf` v then "Integer" else if "char_" `isPrefixOf` v then "Char" else if "string_" `isPrefixOf` v then "String" else if "double_" `isPrefixOf` v then "Double" else if "ident_" `isPrefixOf` v then "Ident" else "Ident" --User-defined type --Just sets the coercion level for parentheses in the Pretty Printer. setI :: Int -> String setI n = "_i_ = " ++ (show n) ++ "; " --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) escapeChars (x:xs) = x : (escapeChars xs) --An extremely simple renderer for terminals. prRender :: String prRender = unlines [ "//You may wish to change render", "void PrintAbsyn::render(Char c)", "{", " if (c == '{')", " {", " bufAppend('\\n');", " indent();", " bufAppend(c);", " _n_ = _n_ + 2;", " bufAppend('\\n');", " indent();", " }", " else if (c == '(' || c == '[')", " bufAppend(c);", " else if (c == ')' || c == ']')", " {", " backup();", " bufAppend(c);", " bufAppend(' ');", " }", " else if (c == '}')", " {", " _n_ = _n_ - 2;", " backup();", " backup();", " bufAppend(c);", " bufAppend('\\n\');", " indent();", " }", " else if (c == ',')", " {", " backup();", " bufAppend(c);", " bufAppend(' ');", " }", " else if (c == ';')", " {", " backup();", " bufAppend(c);", " bufAppend('\\n');", " indent();", " }", " else if (c == 0) return;", " else", " {", " bufAppend(c);", " bufAppend(' ');", " }", "}", "void PrintAbsyn::render(String s)", "{", " if(strlen(s) > 0)", " {", " bufAppend(s);", " bufAppend(' ');", " }", "}", "void PrintAbsyn::indent()", "{", " int n = _n_;", " while (n > 0)", " {", " bufAppend(' ');", " n--;", " }", "}", "void PrintAbsyn::backup()", "{", " if (buf_[cur_ - 1] == ' ')", " {", " buf_[cur_ - 1] = 0;", " cur_--;", " }", "}" ] BNFC-2.6.0.3/src/formats/cpp/CFtoCVisitSkel.hs0000644000000000000000000001724012100475635016741 0ustar0000000000000000{- BNF Converter: C++ Skeleton generation Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C++ Skeleton functions. The generated files use the Visitor design pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 9 August, 2003 Modified : 12 August, 2003 ************************************************************** -} module CFtoCVisitSkel (cf2CVisitSkel) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper) --Produces (.H file, .C file) cf2CVisitSkel :: CF -> (String, String) cf2CVisitSkel cf = (mkHFile cf groups, mkCFile cf groups) where groups = (fixCoercions (ruleGroups cf)) {- **** Header (.H) File Functions **** -} --Generates the Header File mkHFile :: CF -> [(Cat,[Rule])] -> String mkHFile cf groups = unlines [ header, concatMap prDataH groups, concatMap prUserH user, footer ] where user = fst (unzip (tokenPragmas cf)) header = unlines [ "#ifndef SKELETON_HEADER", "#define SKELETON_HEADER", "/* You might want to change the above name. */", "", "#include \"Absyn.H\"", "", "class Skeleton : public Visitor", "{", " public:" ] prUserH u = " void visit" ++ u' ++ "(" ++ u ++ " p);" where u' = ((toUpper (head u)) : (map toLower (tail u))) --this is a hack to fix a potential capitalization problem. footer = unlines [ " void visitIdent(String s);", " void visitInteger(Integer i);", " void visitDouble(Double d);", " void visitChar(Char c);", " void visitString(String s);", "};", "", "#endif" ] --Prints out visit functions for a category prDataH :: (Cat, [Rule]) -> String prDataH (cat, rules) = if "List" `isPrefixOf` (identCat cat) then concat [" void visit", cl, "(", cl, "* ", vname, ");"] else abstract ++ (concatMap prRuleH rules) where cl = identCat (normCat cat) vname = map toLower cl abstract = case lookupRule cat rules of Just x -> "" Nothing -> " void visit" ++ cl ++ "(" ++ cl ++ "*" +++ vname ++ "); /* abstract class */\n" --Visit functions for a rule. prRuleH :: Rule -> String prRuleH (Rule fun c cats) | not (isCoercion fun) = concat [" void visit", fun, "(", fun, "* ", fnm, ");\n"] where fnm = map toLower fun prRuleH _ = "" {- **** Implementation (.C) File Functions **** -} --Makes the .C File mkCFile :: CF -> [(Cat,[Rule])] -> String mkCFile cf groups = concat [ header, concatMap (prData user) groups, concatMap prUser user, footer ] where user = fst (unzip (tokenPragmas cf)) header = unlines [ "/*** BNFC-Generated Visitor Design Pattern Skeleton. ***/", "/* This implements the common visitor design pattern.", " Note that this method uses Visitor-traversal of lists, so", " List->accept() does NOT traverse the list. This allows different", " algorithms to use context information differently. */", "", "#include \"Skeleton.H\"", "" ] prUser x = unlines [ "void Skeleton::visit" ++ x' ++ "(" ++ x ++ " p)", "{", " /* Code for " ++ x ++ " Goes Here */", "}" ] where x' = ((toUpper (head x)) : (map toLower (tail x))) --this is a hack to fix a potential capitalization problem. footer = unlines [ "void Skeleton::visitIdent(Ident i)", "{", " /* Code for Ident Goes Here */", "}", "void Skeleton::visitInteger(Integer i)", "{", " /* Code for Integers Goes Here */", "}", "void Skeleton::visitDouble(Double d)", "{", " /* Code for Doubles Goes Here */", "}", "void Skeleton::visitChar(Char c)", "{", " /* Code for Chars Goes Here */", "}", "void Skeleton::visitString(String s)", "{", " /* Code for Strings Goes Here */", "}", "" ] --Visit functions for a category. prData :: [UserDef] -> (Cat, [Rule]) -> String prData user (cat, rules) = if "List" `isPrefixOf` (identCat cat) then unlines [ "void Skeleton::visit" ++ cl ++ "("++ cl ++ "*" +++ vname ++ ")", "{", " while(" ++ vname ++ "!= 0)", " {", " /* Code For " ++ cl ++ " Goes Here */", visitMember, " " ++ vname ++ " = " ++ vname ++ "->" ++ vname ++ "_;", " }", "}", "" ] --Not a list: else abstract ++ (concatMap (prRule user) rules) where cl = identCat (normCat cat) vname = map toLower cl ecl = identCat (normCatOfList cat) member = map toLower ecl ++ "_" visitMember = if isBasic user member then " visit" ++ (funName member) ++ "(" ++ vname ++ "->" ++ member ++ ");" else " " ++ vname ++ "->" ++ member ++ "->accept(this);" abstract = case lookupRule cat rules of Just x -> "" Nothing -> "void Skeleton::visit" ++ cl ++ "(" ++ cl ++ "*" +++ vname ++ ") {} //abstract class\n\n" --Visits all the instance variables of a category. prRule :: [UserDef] -> Rule -> String prRule user (Rule fun c cats) | not (isCoercion fun) = unlines [ "void Skeleton::visit" ++ fun ++ "(" ++ fun ++ "*" +++ fnm ++ ")", "{", " /* Code For " ++ fun ++ " Goes Here */", "", cats' ++ "}\n" ] where cats' = if allTerms cats then "" else (concatMap (prCat user fnm) (fixOnes (numVars [] cats))) allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs fnm = map toLower fun prRule user _ = "" --Prints the actual instance-variable visiting. prCat user fnm c = case c of (Right t) -> "" (Left nt) -> if isBasic user nt then " visit" ++ (funName nt) ++ "(" ++ fnm ++ "->" ++ nt ++ ");\n" else if "list" `isPrefixOf` nt then " if (" ++ fnm ++ "->" ++ nt ++ ") {" ++ accept ++ "}\n" else " " ++ accept ++ "\n" where accept = fnm ++ "->" ++ nt ++ "->accept(this);" --Just checks if something is a basic or user-defined type. --This is because you don't -> a basic non-pointer type. isBasic :: [UserDef] -> String -> Bool isBasic user v = if elem (init v) user' then True else if "integer_" `isPrefixOf` v then True else if "char_" `isPrefixOf` v then True else if "string_" `isPrefixOf` v then True else if "double_" `isPrefixOf` v then True else if "ident_" `isPrefixOf` v then True else False where user' = map (map toLower) user --The visit-function name of a basic type funName :: String -> String funName v = if "integer_" `isPrefixOf` v then "Integer" else if "char_" `isPrefixOf` v then "Char" else if "string_" `isPrefixOf` v then "String" else if "double_" `isPrefixOf` v then "Double" else if "ident_" `isPrefixOf` v then "Ident" else (toUpper (head v)) : (init (tail v)) --User-defined type BNFC-2.6.0.3/src/formats/c/0000755000000000000000000000000012100475635013245 5ustar0000000000000000BNFC-2.6.0.3/src/formats/c/CFtoFlexC.hs0000644000000000000000000001521712100475635015364 0ustar0000000000000000{- BNF Converter: C flex generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Flex file. It is similar to JLex but with a few peculiarities. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 5 August, 2003 Modified : 10 August, 2003 ************************************************************** -} module CFtoFlexC (cf2flex) where import CF import RegToFlex -- import Utils((+++), (++++)) import NamedVariables import Data.List --The environment must be returned for the parser to use. cf2flex :: String -> CF -> (String, SymEnv) cf2flex name cf = (unlines [ prelude name, cMacros, lexSymbols env, restOfFlex cf env' ], env') where env = makeSymEnv (symbols cf ++ reservedWords cf) (0 :: Int) env' = env ++ (makeSymEnv (fst (unzip (tokenPragmas cf))) (length env)) makeSymEnv [] _ = [] makeSymEnv (s:symbs) n = (s, "_SYMB_" ++ (show n)) : (makeSymEnv symbs (n+1)) prelude :: String -> String prelude name = unlines [ "/* -*- c -*- This FLex file was machine-generated by the BNF converter */", "%option noyywrap", "%{", "#define yylval " ++ name ++ "lval", "#define YY_BUFFER_APPEND " ++ name ++ "_BUFFER_APPEND", "#define YY_BUFFER_RESET " ++ name ++ "_BUFFER_RESET", "#define initialize_lexer " ++ name ++ "_initialize_lexer", "#include ", "#include \"Parser.h\"", "#define YY_BUFFER_LENGTH 4096", "char YY_PARSED_STRING[YY_BUFFER_LENGTH];", "void YY_BUFFER_APPEND(char *s)", "{", " strcat(YY_PARSED_STRING, s); //Do something better here!", "}", "void YY_BUFFER_RESET(void)", "{", " int x;", " for(x = 0; x < YY_BUFFER_LENGTH; x++)", " YY_PARSED_STRING[x] = 0;", "}", "", "%}" ] --For now all categories are included. --Optimally only the ones that are used should be generated. cMacros :: String cMacros = unlines [ "LETTER [a-zA-Z]", "CAPITAL [A-Z]", "SMALL [a-z]", "DIGIT [0-9]", "IDENT [a-zA-Z0-9'_]", "%START YYINITIAL COMMENT CHAR CHARESC CHAREND STRING ESCAPED", "%%" ] lexSymbols :: SymEnv -> String lexSymbols ss = concatMap transSym ss where transSym (s,r) = "\"" ++ s' ++ "\" \t return " ++ r ++ ";\n" where s' = escapeChars s restOfFlex :: CF -> SymEnv -> String restOfFlex cf env = concat [ lexComments (comments cf), userDefTokens, ifC "String" strStates, ifC "Char" chStates, ifC "Double" "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t yylval.double_ = atof(yytext); return _DOUBLE_;\n", ifC "Integer" "{DIGIT}+ \t yylval.int_ = atoi(yytext); return _INTEGER_;\n", ifC "Ident" "{LETTER}{IDENT}* \t yylval.string_ = strdup(yytext); return _IDENT_;\n" , "[ \\t\\r\\n\\f] \t /* ignore white space. */;\n", ". \t return _ERROR_;\n", "%%\n", footer ] where ifC cat s = if isUsedCat cf cat then s else "" userDefTokens = unlines $ ["" ++ printRegFlex exp ++ " \t yylval.string_ = strdup(yytext); return " ++ sName name ++ ";" | (name, exp) <- tokenPragmas cf] where sName n = case lookup n env of Just x -> x Nothing -> n strStates = unlines --These handle escaped characters in Strings. [ "\"\\\"\" \t BEGIN STRING;", "\\\\ \t BEGIN ESCAPED;", "\\\" \t yylval.string_ = strdup(YY_PARSED_STRING); YY_BUFFER_RESET(); BEGIN YYINITIAL; return _STRING_;", ". \t YY_BUFFER_APPEND(yytext);", "n \t YY_BUFFER_APPEND(\"\\n\"); BEGIN STRING;", "\\\" \t YY_BUFFER_APPEND(\"\\\"\"); BEGIN STRING ;", "\\\\ \t YY_BUFFER_APPEND(\"\\\\\"); BEGIN STRING;", "t \t YY_BUFFER_APPEND(\"\\t\"); BEGIN STRING;", ". \t YY_BUFFER_APPEND(yytext); BEGIN STRING;" ] chStates = unlines --These handle escaped characters in Chars. [ "\"'\" \tBEGIN CHAR;", "\\\\ \t BEGIN CHARESC;", "[^'] \t BEGIN CHAREND; yylval.char_ = yytext[0]; return _CHAR_;", "n \t BEGIN CHAREND; yylval.char_ = '\\n'; return _CHAR_;", "t \t BEGIN CHAREND; yylval.char_ = '\\t'; return _CHAR_;", ". \t BEGIN CHAREND; yylval.char_ = yytext[0]; return _CHAR_;", "\"'\" \t BEGIN YYINITIAL;" ] footer = "void initialize_lexer(FILE *inp) { yyin = inp; BEGIN YYINITIAL; }" lexComments :: ([(String, String)], [String]) -> String lexComments (m,s) = (unlines (map lexSingleComment s)) ++ (unlines (map lexMultiComment m)) lexSingleComment :: String -> String lexSingleComment c = "\"" ++ c ++ "\"[^\\n]*\\n \t /* BNFC single-line comment */;" --There might be a possible bug here if a language includes 2 multi-line comments. --They could possibly start a comment with one character and end it with another. --However this seems rare. lexMultiComment :: (String, String) -> String lexMultiComment (b,e) = unlines [ "\"" ++ b ++ "\" \t BEGIN COMMENT;", "\"" ++ e ++ "\" \t BEGIN YYINITIAL;", ". \t /* BNFC multi-line comment */;", "[\\n] \t /* BNFC multi-line comment */;" ] lexReserved :: String -> String lexReserved s = "\"" ++ s ++ "\" \t yylval.string_ = strdup(yytext); return TS;" --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) escapeChars (x:xs) = x : (escapeChars xs) BNFC-2.6.0.3/src/formats/c/CFtoCAbs.hs0000644000000000000000000002332212100475635015167 0ustar0000000000000000{- BNF Converter: C Abstract syntax Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C Abstract Syntax tree classes. It generates both a Header file and an Implementation file, and Appel's C method. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 15 September, 2003 Modified : 15 September, 2003 ************************************************************** -} module CFtoCAbs (cf2CAbs) where import CF import Utils((+++),(++++)) import NamedVariables import Data.List import Data.Char(toLower) --The result is two files (.H file, .C file) cf2CAbs :: String -> CF -> (String, String) cf2CAbs name cf = (mkHFile cf, mkCFile cf) {- **** Header (.H) File Functions **** -} --Makes the Header file. mkHFile :: CF -> String mkHFile cf = unlines [ "#ifndef ABSYN_HEADER", "#define ABSYN_HEADER", "", header, prTypeDefs user, "/******************** Forward Declarations ********************/\n", concatMap prForward classes, "", "/******************** Abstract Syntax Classes ********************/\n", concatMap (prDataH user) (cf2dataLists cf), "", "#endif" ] where user = fst (unzip (tokenPragmas cf)) header = "/* C++ Abstract Syntax Interface generated by the BNF Converter.*/\n" rules = getRules cf classes = rules ++ getClasses (allCats cf) prForward s | not (isCoercion s) = unlines [ "struct " ++ s' ++ "_;", "typedef struct " ++ s' ++ "_ *" ++ s' ++ ";" ] where s' = normCat s prForward s = "" getRules cf = (map testRule (rulesOfCF cf)) getClasses [] = [] getClasses (c:cs) = if identCat (normCat c) /= c then getClasses cs else if elem c rules then getClasses cs else c : (getClasses cs) testRule (Rule f c r) = if isList c then if isConsFun f then identCat c else "_" --ignore this else "_" --Prints struct definitions for all categories. prDataH :: [UserDef] -> Data -> String prDataH user (cat, rules) = if isList cat then unlines [ "struct " ++ c' ++ "_", "{", " " ++ mem +++ (varName mem) ++ ";", " " ++ c' +++ (varName c') ++ ";", "};", "", c' ++ " make_" ++ c' ++ "(" ++ mem ++ " p1, " ++ c' ++ " p2);" ] else unlines [ "struct " ++ cat ++ "_", "{", " enum { " ++ (concat (intersperse ", " (map prKind rules))) ++ " } kind;", " union", " {", concatMap (prUnion user) rules ++ " } u;", "};", "", concatMap (prRuleH user cat) rules ] where c' = identCat (normCat cat) mem = identCat (normCatOfList cat) prKind (fun, cats) = "is_" ++ (normCat fun) prMember user (fun, []) = "" prMember user (fun, cats) = " " ++ (prInstVars user (getVars cats)) prUnion user (fun, []) = "" prUnion user (fun, cats) = " struct { " ++ (prInstVars user (getVars cats)) ++ " } " ++ (memName fun) ++ ";\n" --Interface definitions for rules vary on the type of rule. prRuleH :: [UserDef] -> String -> (Fun, [Cat]) -> String prRuleH user c (fun, cats) = if isNilFun fun || isOneFun fun || isConsFun fun then "" --these are not represented in the AbSyn else --a standard rule c ++ " make_" ++ fun' ++ "(" ++ (prParamsH 0 (getVars cats)) ++ ");\n" where fun' = identCat (normCat fun) prParamsH :: Int -> [(String, a)] -> String prParamsH _ [] = "" prParamsH n ((t,_):[]) = t ++ " p" ++ (show n) prParamsH n ((t,_):vs) = (t ++ " p" ++ (show n) ++ ", ") ++ (prParamsH (n+1) vs) --typedefs in the Header make generation much nicer. prTypeDefs user = unlines [ "/******************** TypeDef Section ********************/", "typedef int Integer;", "typedef char Char;", "typedef double Double;", "typedef char* String;", "typedef char* Ident;", concatMap prUserDef user ] where prUserDef s = "typedef char* " ++ s ++ ";\n" --A class's instance variables. prInstVars :: [UserDef] -> [IVar] -> String prInstVars _ [] = [] prInstVars user vars@((t,n):[]) = t +++ uniques where (uniques, vs') = prUniques t vars prInstVars user vars@((t,n):vs) = t +++ uniques ++ (prInstVars user vs') where (uniques, vs') = prUniques t vars --these functions group the types together nicely prUniques :: String -> [IVar] -> (String, [IVar]) prUniques t vs = (prVars (findIndices (\x -> case x of (y,_) -> y == t) vs) vs, remType t vs) where remType :: String -> [IVar] -> [IVar] remType _ [] = [] remType t ((t2,n):ts) = if t == t2 then (remType t ts) else (t2,n) : (remType t ts) prVars (x:[]) vs = case vs !! x of (t,n) -> (varName t) ++ (showNum n) ++ ";" prVars (x:xs) vs = case vs !! x of (t,n) -> (varName t) ++ (showNum n) ++ ", " ++ (prVars xs vs) {- **** Implementation (.C) File Functions **** -} --Makes the .C file mkCFile :: CF -> String mkCFile cf = unlines [ header, concatMap (prDataC user) (cf2dataLists cf) ] where user = fst (unzip (tokenPragmas cf)) header = unlines [ "/* C Abstract Syntax Implementation generated by the BNF Converter. */", "", "#include ", "#include ", "#include \"Absyn.h\"", "" ] --This is not represented in the implementation. --This is not represented in the implementation. prDataC :: [UserDef] -> Data -> String prDataC user (cat, rules) = concatMap (prRuleC user cat) rules --Classes for rules vary based on the type of rule. prRuleC user c (fun, cats) = if isNilFun fun || isOneFun fun then "" --these are not represented in the AbSyn else if isConsFun fun then --this is the linked list case. unlines [ "/******************** " ++ c' ++ " ********************/", prListFuncs user c', "" ] else --a standard rule unlines [ "/******************** " ++ fun' ++ " ********************/", prConstructorC user c fun' vs cats, "" ] where vs = getVars cats fun' = identCat (normCat fun) c' = identCat (normCat c) --These are all built-in list functions. --Later we could include things like lookup,insert,delete,etc. prListFuncs :: [UserDef] -> String -> String prListFuncs user c = unlines [ c ++ " make_" ++ c ++"(" ++ m ++ " p1" ++ ", " ++ c ++ " p2)", "{", " " ++ c ++ " tmp = (" ++ c ++ ") malloc(sizeof(*tmp));", " if (!tmp)", " {", " fprintf(stderr, \"Error: out of memory when allocating " ++ c ++ "!\\n\");", " exit(1);", " }", " tmp->" ++ m' ++ " = " ++ "p1;", " tmp->" ++ v ++ " = " ++ "p2;", " return tmp;", "}" ] where v = (map toLower c) ++ "_" m = drop 4 c m' = drop 4 v --The constructor just assigns the parameters to the corresponding instance variables. prConstructorC :: [UserDef] -> String -> String -> [IVar] -> [Cat] -> String prConstructorC user cat c vs cats = unlines [ cat' ++ " make_" ++ c ++"(" ++ (interleave types params) ++ ")", "{", " " ++ cat' ++ " tmp = (" ++ cat' ++ ") malloc(sizeof(*tmp));", " if (!tmp)", " {", " fprintf(stderr, \"Error: out of memory when allocating " ++ c ++ "!\\n\");", " exit(1);", " }", " tmp->kind = is_" ++ c ++ ";", prAssigns c vs params, " return tmp;", "}" ] where cat' = identCat (normCat cat) (types, params) = unzip (prParams cats (length cats) ((length cats)+1)) interleave _ [] = [] interleave (x:[]) (y:[]) = x +++ y interleave (x:xs) (y:ys) = x +++ y ++ "," +++ (interleave xs ys) --Prints the constructor's parameters. prParams :: [Cat] -> Int -> Int -> [(String,String)] prParams [] _ _ = [] prParams (c:cs) n m = (identCat c,"p" ++ (show (m-n))) : (prParams cs (n-1) m) --Prints the assignments of parameters to instance variables. --This algorithm peeks ahead in the list so we don't use map or fold prAssigns :: String -> [IVar] -> [String] -> String prAssigns _ [] _ = [] prAssigns _ _ [] = [] prAssigns c ((t,n):vs) (p:ps) = if n == 1 then case findIndices (\x -> case x of (l,r) -> l == t) vs of [] -> " tmp->u." ++ c' ++ "_." ++ (varName t) ++ " = " ++ p ++ ";\n" ++ (prAssigns c vs ps) z -> " tmp->u." ++ c' ++ "_." ++ ((varName t) ++ (showNum n)) ++ " = " ++ p ++ ";\n" ++ (prAssigns c vs ps) else " tmp->u." ++ c' ++ "_." ++ ((varName t) ++ (showNum n)) ++ " = " ++ p ++ ";\n" ++ (prAssigns c vs ps) where c' = map toLower c {- **** Helper Functions **** -} --Checks if something is a basic or user-defined type. isBasic :: [UserDef] -> String -> Bool isBasic user x = if elem x user then True else case x of "Integer" -> True "Char" -> True "String" -> True "Double" -> True "Ident" -> True _ -> False memName s = (map toLower s) ++ "_" BNFC-2.6.0.3/src/formats/c/CFtoBisonC.hs0000644000000000000000000002124712100475635015540 0ustar0000000000000000{- BNF Converter: C Bison generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Bison input file. Note that because of the way bison stores results the programmer can increase performance by limiting the number of entry points in their grammar. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 6 August, 2003 Modified : 6 August, 2003 ************************************************************** -} module CFtoBisonC (cf2Bison) where import CF import Data.List (intersperse, isPrefixOf) import NamedVariables hiding (varName) import Data.Char (toLower) import Utils ((+++), (++++)) --This follows the basic structure of CFtoHappy. -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String --The environment comes from the CFtoFlex cf2Bison :: String -> CF -> SymEnv -> String cf2Bison name cf env = unlines [header name cf, union (allCats cf), "%token _ERROR_", tokens user env, declarations cf, specialToks cf, "%%", prRules (rulesForBison name cf env) ] where user = fst (unzip (tokenPragmas cf)) header :: String -> CF -> String header name cf = unlines ["/* This Bison file was machine-generated by BNFC */", "%{", "#include ", "#include ", "#include ", "#include \"Absyn.h\"", "#define initialize_lexer " ++ name ++ "_initialize_lexer", "extern int yyparse(void);", "extern int yylex(void);", "extern int initialize_lexer(FILE * inp);", "void yyerror(const char *str)", "{", " fprintf(stderr,\"error: %s\\n\",str);", "}", "", -- M.F. 2004-09-17 changed allEntryPoints to allCatsIdNorm. Seems to fix the [Ty2] bug. unlines $ map (parseMethod name) (allCatsIdNorm cf), -- (allEntryPoints cf), concatMap reverseList (filter isList (allCats cf)), "%}" ] --This generates a parser method for each entry point. parseMethod :: String -> Cat -> String parseMethod name cat = -- if normCat cat /= cat M.F. 2004-09-17 comment. No duplicates from allCatsIdNorm -- then "" -- else unlines [ cat' +++ (resultName cat') +++ "= 0;", cat' ++ " p" ++ cat' ++ "(FILE *inp)", "{", " initialize_lexer(inp);", " if (yyparse())", " { /* Failure */", " return 0;", " }", " else", " { /* Success */", " return" +++ (resultName cat') ++ ";", " }", "}" ] where cat' = identCat (normCat cat) --This method generates list reversal functions for each list type. reverseList :: Cat -> String reverseList c = unlines [ c' ++ " reverse" ++ c' ++ "(" ++ c' +++ "l)", "{", " " ++ c' +++"prev = 0;", " " ++ c' +++"tmp = 0;", " while (l)", " {", " tmp = l->" ++ v ++ ";", " l->" ++ v +++ "= prev;", " prev = l;", " l = tmp;", " }", " return prev;", "}" ] where c' = identCat (normCat c) v = (map toLower c') ++ "_" --The union declaration is special to Bison/Yacc and gives the type of yylval. --For efficiency, we may want to only include used categories here. union :: [Cat] -> String union cats = unlines [ "%union", "{", " int int_;", " char char_;", " double double_;", " char* string_;", concatMap mkPointer cats, "}" ] where --This is a little weird because people can make [Exp2] etc. mkPointer s | identCat s /= s = --list. add it even if it refers to a coercion. " " ++ (identCat (normCat s)) +++ (varName (normCat s)) ++ ";\n" mkPointer s | normCat s == s = --normal cat " " ++ (identCat (normCat s)) +++ (varName (normCat s)) ++ ";\n" mkPointer s = "" --declares non-terminal types. declarations :: CF -> String declarations cf = concatMap (typeNT cf) (allCats cf) where --don't define internal rules typeNT cf nt | rulesForCat cf nt /= [] = "%type <" ++ (varName (normCat nt)) ++ "> " ++ (identCat nt) ++ "\n" typeNT cf nt = "" --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user ts = concatMap (declTok user) ts where declTok u (s,r) = if elem s u then "%token " ++ r ++ " /* " ++ s ++ " */\n" else "%token " ++ r ++ " /* " ++ s ++ " */\n" specialToks :: CF -> String specialToks cf = concat [ ifC "String" "%token _STRING_\n", ifC "Char" "%token _CHAR_\n", ifC "Integer" "%token _INTEGER_\n", ifC "Double" "%token _DOUBLE_\n", ifC "Ident" "%token _IDENT_\n" ] where ifC cat s = if isUsedCat cf cat then s else "" --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForBison :: String -> CF -> SymEnv -> Rules rulesForBison name cf env = map mkOne $ ruleGroups cf where mkOne (cat,rules) = constructRule cf env rules cat -- For every non-terminal, we construct a set of rules. constructRule :: CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule cf env rules nt = (nt,[(p,(generateAction (normCat (identCat nt)) (ruleName r) b m) +++ result) | r0 <- rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True,revSepListRule r0) else (False,r0), let (p,m) = generatePatterns cf env r]) where ruleName r = case funRule r of "(:)" -> identCat nt z -> z revs = reversibleCats cf eps = allEntryPoints cf isEntry nt = if elem nt eps then True else False result = if isEntry nt then (resultName (normCat (identCat nt))) ++ "= $$;" else "" -- Generates a string containing the semantic action. generateAction :: NonTerminal -> Fun -> Bool -> [MetaVar] -> Action generateAction nt f b ms = if isCoercion f then (unwords ms) ++ ";" else if isNilFun f then "0;" else if isOneFun f then concat ["make_", nt, "(", (concat (intersperse ", " ms')), ", 0);"] else concat ["make_", normCat f, "(", (concat (intersperse ", " ms')), ");"] where ms' = if b then reverse ms else ms -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: CF -> SymEnv -> Rule -> (Pattern,[MetaVar]) generatePatterns cf env r = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> case lookup c env of Just x -> x Nothing -> typeName (identCat c) Right s -> case lookup s env of Just x -> x Nothing -> s metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 :: Int ..] its] revIf c m = if (not (isConsFun (funRule r)) && elem c revs) then ("reverse" ++ (identCat (normCat c)) ++ "(" ++ m ++ ")") else m -- no reversal in the left-recursive Cons rule itself revs = reversibleCats cf -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. prRules :: Rules -> String prRules [] = [] prRules ((nt, []):rs) = prRules rs --internal rule prRules ((nt,((p,a):ls)):rs) = (unwords [nt', ":" , p, "{ $$ =", a, "}", "\n" ++ pr ls]) ++ ";\n" ++ prRules rs where nt' = identCat nt pr [] = [] pr ((p,a):ls) = (unlines [(concat $ intersperse " " [" |", p, "{ $$ =", a , "}"])]) ++ pr ls --Some helper functions. resultName :: String -> String resultName s = "YY_RESULT_" ++ s ++ "_" --slightly stronger than the NamedVariable version. varName :: String -> String varName s = (map toLower (identCat s)) ++ "_" typeName :: String -> String typeName "Ident" = "_IDENT_" typeName "String" = "_STRING_" typeName "Char" = "_CHAR_" typeName "Integer" = "_INTEGER_" typeName "Double" = "_DOUBLE_" typeName x = x BNFC-2.6.0.3/src/formats/c/CTop.hs0000644000000000000000000001507112100475635014452 0ustar0000000000000000{- BNF Converter: C Main file Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CTop (makeC) where import Utils import CF import CFtoCAbs import CFtoFlexC import CFtoBisonC import CFtoCSkel import CFtoCPrinter import CFtoLatex import Data.Char import System.Exit (exitFailure) makeC :: Bool -> String -> CF -> IO () makeC make name cf = do let (hfile, cfile) = cf2CAbs name cf writeFileRep "Absyn.h" hfile writeFileRep "Absyn.c" cfile let (flex, env) = cf2flex name cf writeFileRep (name ++ ".l") flex putStrLn " (Tested with flex 2.5.31)" let bison = cf2Bison name cf env writeFileRep (name ++ ".y") bison putStrLn " (Tested with bison 1.875a)" let header = mkHeaderFile cf (allCats cf) (allEntryPoints cf) env writeFileRep "Parser.h" header let (skelH, skelC) = cf2CSkel cf writeFileRep "Skeleton.h" skelH writeFileRep "Skeleton.c" skelC let (prinH, prinC) = cf2CPrinter cf writeFileRep "Printer.h" prinH writeFileRep "Printer.c" prinC writeFileRep "Test.c" (ctest cf) let latex = cfToLatex name cf writeFileRep (name ++ ".tex") latex if make then (writeFileRep "Makefile" $ makefile name) else return () makefile :: String -> String makefile name = unlines [ "CC = gcc", "CCFLAGS = -g -W -Wall", "", "FLEX = flex", "FLEX_OPTS = -P" ++ name, "", "BISON = bison", "BISON_OPTS = -t -p" ++ name, "", "LATEX = pdflatex", "", "all: Test" ++ name ++ " " ++ name ++ ".pdf", "", ".PHONY: clean distclean", "", "clean:", -- peteg: don't nuke what we generated - move that to the "vclean" target. "\trm -f *.o " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".pdf Test" ++ name, "", "distclean: clean", -- FIXME "\trm -f *.o Absyn.c Absyn.h Test.c Parser.c Parser.h Lexer.c Skeleton.c Skeleton.h Printer.c Printer.h " ++ name ++ ".l " ++ name ++ ".y " ++ name ++ ".tex " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".pdf Test" ++ name ++ " Makefile", "", "Test" ++ name ++ ": Absyn.o Lexer.o Parser.o Printer.o Test.o", "\t@echo \"Linking test" ++ name ++ "...\"", "\t${CC} ${CCFLAGS} *.o -o Test" ++ name ++ "", "", "Absyn.o: Absyn.c Absyn.h", "\t${CC} ${CCFLAGS} -c Absyn.c", "", "Lexer.c: " ++ name ++ ".l", "\t${FLEX} ${FLEX_OPTS} -oLexer.c " ++ name ++ ".l", "", "Parser.c: " ++ name ++ ".y", "\t${BISON} ${BISON_OPTS} " ++ name ++ ".y -o Parser.c", "", "Lexer.o: Lexer.c Parser.h", "\t${CC} ${CCFLAGS} -c Lexer.c ", "", "Parser.o: Parser.c Absyn.h", "\t${CC} ${CCFLAGS} -c Parser.c", "", "Printer.o: Printer.c Printer.h Absyn.h", "\t${CC} ${CCFLAGS} -c Printer.c", "", "Test.o: Test.c Parser.h Printer.h Absyn.h", "\t${CC} ${CCFLAGS} -c Test.c", "", "" ++ name ++ ".pdf: " ++ name ++ ".tex", "\t${LATEX} " ++ name ++ ".tex", "" ] ctest :: CF -> String ctest cf = unlines [ "/*** Compiler Front-End Test automatically generated by the BNF Converter ***/", "/* */", "/* This test will parse a file, print the abstract syntax tree, and then */", "/* pretty-print the result. */", "/* */", "/****************************************************************************/", "", "#include ", "#include ", "", "#include \"Parser.h\"", "#include \"Printer.h\"", "#include \"Absyn.h\"", "", "int main(int argc, char ** argv)", "{", " FILE *input;", " " ++ def ++ " parse_tree;", " if (argc > 1) ", " {", " input = fopen(argv[1], \"r\");", " if (!input)", " {", " fprintf(stderr, \"Error opening input file.\\n\");", " exit(1);", " }", " }", " else input = stdin;", " /* The default entry point is used. For other options see Parser.h */", " parse_tree = p" ++ def ++ "(input);", " if (parse_tree)", " {", " printf(\"\\nParse Succesful!\\n\");", " printf(\"\\n[Abstract Syntax]\\n\");", " printf(\"%s\\n\\n\", show" ++ def ++ "(parse_tree));", " printf(\"[Linearized Tree]\\n\");", " printf(\"%s\\n\\n\", print" ++ def ++ "(parse_tree));", " return 0;", " }", " return 1;", "}", "" ] where def = head (allEntryPoints cf) mkHeaderFile :: CF -> [Cat] -> [Cat] -> [(a, String)] -> String mkHeaderFile cf cats eps env = unlines [ "#ifndef PARSER_HEADER_FILE", "#define PARSER_HEADER_FILE", "", "#include \"Absyn.h\"", "", "typedef union", "{", " int int_;", " char char_;", " double double_;", " char* string_;", (concatMap mkVar cats) ++ "} YYSTYPE;", "", "#define _ERROR_ 258", mkDefines (259::Int) env, "extern YYSTYPE yylval;", concatMap mkFunc eps, "", "#endif" ] where mkVar s | (normCat s == s) = " " ++ (identCat s) +++ (map toLower (identCat s)) ++ "_;\n" mkVar _ = "" mkDefines n [] = mkString n mkDefines n ((_,s):ss) = ("#define " ++ s +++ (show n) ++ "\n") ++ (mkDefines (n+1) ss) mkString n = if isUsedCat cf "String" then ("#define _STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) else mkChar n mkChar n = if isUsedCat cf "Char" then ("#define _CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) else mkInteger n mkInteger n = if isUsedCat cf "Integer" then ("#define _INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) else mkDouble n mkDouble n = if isUsedCat cf "Double" then ("#define _DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) else mkIdent n mkIdent n = if isUsedCat cf "Ident" then ("#define _IDENT_ " ++ show n ++ "\n") else "" mkFunc s | (normCat s == s) = (identCat s) ++ " p" ++ (identCat s) ++ "(FILE *inp);\n" mkFunc _ = "" BNFC-2.6.0.3/src/formats/c/CFtoCSkel.hs0000644000000000000000000001547412100475635015371 0ustar0000000000000000{- BNF Converter: C Skeleton generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C Skeleton functions. The generated files follow Appel's case method. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 9 August, 2003 Modified : 12 August, 2003 ************************************************************** -} module CFtoCSkel (cf2CSkel) where import CF import Utils ( (+++) ) import NamedVariables import Data.List ( isPrefixOf ) import Data.Char ( toLower, toUpper ) --Produces (.H file, .C file) cf2CSkel :: CF -> (String, String) cf2CSkel cf = (mkHFile cf groups, mkCFile cf groups) where groups = (fixCoercions (ruleGroups cf)) {- **** Header (.H) File Functions **** -} --Generates the Header File mkHFile :: CF -> [(Cat,[Rule])] -> String mkHFile cf groups = unlines [ header, concatMap prDataH groups, concatMap prUserH user, footer ] where user = fst (unzip (tokenPragmas cf)) header = unlines [ "#ifndef SKELETON_HEADER", "#define SKELETON_HEADER", "/* You might want to change the above name. */", "", "#include \"Absyn.h\"", "" ] prUserH u = "void visit" ++ u' ++ "(" ++ u ++ " p);" where u' = ((toUpper (head u)) : (map toLower (tail u))) --this is a hack to fix a potential capitalization problem. footer = unlines [ "void visitIdent(Ident i);", "void visitInteger(Integer i);", "void visitDouble(Double d);", "void visitChar(Char c);", "void visitString(String s);", "", "#endif" ] --Prints out visit functions for a category prDataH :: (Cat, [Rule]) -> String prDataH (cat, _rules) = if isList cat then concat ["void visit", cl, "(", cl, " p);\n"] else "void visit" ++ cl ++ "(" ++ cl ++ " p);\n" where cl = identCat $ normCat cat {- **** Implementation (.C) File Functions **** -} --Makes the .C File mkCFile :: CF -> [(Cat,[Rule])] -> String mkCFile cf groups = concat [ header, concatMap (prData user) groups, concatMap prUser user, footer ] where user = fst (unzip (tokenPragmas cf)) header = unlines [ "/*** BNFC-Generated Visitor Traversal Skeleton. ***/", "/* This traverses the abstract syntax tree.", " To use, copy Skeleton.h and Skeleton.c to", " new files. */", "", "#include \"Skeleton.h\"", "" ] prUser u = unlines [ "void visit" ++ u' ++ "(" ++ u ++ " p)", "{", " /* Code for " ++ u ++ " Goes Here */", "}" ] where u' = ((toUpper (head u)) : (map toLower (tail u))) --this is a hack to fix a potential capitalization problem. footer = unlines [ "void visitIdent(Ident i)", "{", " /* Code for Ident Goes Here */", "}", "void visitInteger(Integer i)", "{", " /* Code for Integer Goes Here */", "}", "void visitDouble(Double d)", "{", " /* Code for Double Goes Here */", "}", "void visitChar(Char c)", "{", " /* Code for Char Goes Here */", "}", "void visitString(String s)", "{", " /* Code for String Goes Here */", "}", "" ] --Visit functions for a category. prData :: [UserDef] -> (Cat, [Rule]) -> String prData user (cat, rules) = if isList cat then unlines [ "void visit" ++ cl ++ "("++ cl +++ vname ++ ")", "{", " while(" ++ vname ++ " != 0)", " {", " /* Code For " ++ cl ++ " Goes Here */", " visit" ++ ecl ++ "(" ++ vname ++ "->" ++ member ++ "_);", " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", "}", "" ] -- Not a list: else unlines [ "void visit" ++ cl ++ "(" ++ cl ++ " _p_)", "{", " switch(_p_->kind)", " {", concatMap (prPrintRule user) rules, " default:", " fprintf(stderr, \"Error: bad kind field when printing " ++ cl ++ "!\\n\");", " exit(1);", " }", "}\n" ] where cl = identCat $ normCat cat ecl = identCat $ normCatOfList cat vname = map toLower cl member = map toLower ecl -- Visits all the instance variables of a category. prPrintRule :: [UserDef] -> Rule -> String prPrintRule user (Rule fun _c cats) | not (isCoercion fun) = unlines [ " case is_" ++ fun ++ ":", " /* Code for " ++ fun ++ " Goes Here */", cats' ++ " break;" ] where cats' = concatMap (prCat user fun) (zip (fixOnes (numVars [] cats)) cats) prPrintRule _user (Rule _fun _ _) = "" -- Prints the actual instance-variable visiting. prCat :: [UserDef] -> String -> (Either Cat Cat, Either Cat Cat) -> String prCat user fnm (c, o) = case c of Right {} -> "" Left nt -> if isBasic user nt then " visit" ++ basicFunName nt ++ "(_p_->u." ++ v ++ "_." ++ nt ++ ");\n" else " visit" ++ o' ++ "(_p_->u." ++ v ++ "_." ++ nt ++ ");\n" where v = map toLower $ identCat $ normCat fnm o' = case o of Right x -> x Left x -> normCat $ identCat x --Just checks if something is a basic or user-defined type. --This is because you don't -> a basic non-pointer type. isBasic :: [UserDef] -> String -> Bool isBasic user v = if elem (init v) user' then True else if "integer_" `isPrefixOf` v then True else if "char_" `isPrefixOf` v then True else if "string_" `isPrefixOf` v then True else if "double_" `isPrefixOf` v then True else if "ident_" `isPrefixOf` v then True else False where user' = map (map toLower) user --The visit-function name of a basic type basicFunName :: String -> String basicFunName v = if "integer_" `isPrefixOf` v then "Integer" else if "char_" `isPrefixOf` v then "Char" else if "string_" `isPrefixOf` v then "String" else if "double_" `isPrefixOf` v then "Double" else if "ident_" `isPrefixOf` v then "Ident" else (toUpper (head v)) : (init (tail v)) --User-defined type BNFC-2.6.0.3/src/formats/c/CFtoCPrinter.hs0000644000000000000000000004261712100475635016115 0ustar0000000000000000{- BNF Converter: C Pretty Printer printer Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C Pretty Printer. It also generates the "show" method for printing an abstract syntax tree. The generated files use the Visitor design pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 10 August, 2003 Modified : 3 September, 2003 * Added resizable buffers ************************************************************** -} module CFtoCPrinter (cf2CPrinter) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper) --Produces (.h file, .c file) cf2CPrinter :: CF -> (String, String) cf2CPrinter cf = (mkHFile cf groups, mkCFile cf groups) where groups = (fixCoercions (ruleGroupsInternals cf)) {- **** Header (.h) File Methods **** -} --An extremely large function to make the Header File mkHFile :: CF -> [(Cat,[Rule])] -> String mkHFile cf groups = unlines [ header, concatMap prPrints eps, concatMap prPrintDataH groups, concatMap prShows eps, concatMap prShowDataH groups, footer ] where eps = allEntryPoints cf prPrints s | normCat s == s = "char* print" ++ s' ++ "(" ++ s' ++ " p);\n" where s' = identCat s prPrints _ = "" prShows s | normCat s == s = "char* show" ++ s' ++ "(" ++ s' ++ " p);\n" where s' = identCat s prShows _ = "" header = unlines [ "#ifndef PRINTER_HEADER", "#define PRINTER_HEADER", "", "#include \"Absyn.h\"", "", "/* Certain applications may improve performance by changing the buffer size */", "#define BUFFER_INITIAL 2000", "/* You may wish to change _L_PAREN or _R_PAREN */", "#define _L_PAREN '('", "#define _R_PAREN ')'", "", "/* The following are simple heuristics for rendering terminals */", "/* You may wish to change them */", "void renderCC(Char c);", "void renderCS(String s);", "void indent(void);", "void backup(void);", "" ] footer = unlines $ ["void pp" ++ t ++ "(String s, int i);" | t <- tokenNames cf] ++ ["void sh" ++ t ++ "(String s);" | t <- tokenNames cf] ++ [ "void ppInteger(Integer n, int i);", "void ppDouble(Double d, int i);", "void ppChar(Char c, int i);", "void ppString(String s, int i);", "void ppIdent(String s, int i);", "void shInteger(Integer n);", "void shDouble(Double d);", "void shChar(Char c);", "void shString(String s);", "void shIdent(String s);", "void bufAppendS(const char* s);", "void bufAppendC(const char c);", "void bufReset(void);", "void resizeBuffer(void);", "", "#endif" ] --Prints all the required method names and their parameters. prPrintDataH :: (Cat, [Rule]) -> String prPrintDataH (cat, rules) = concat ["void pp", cl, "(", cl, " p, int i);\n"] where cl = identCat (normCat cat) --Prints all the required method names and their parameters. prShowDataH :: (Cat, [Rule]) -> String prShowDataH (cat, rules) = concat ["void sh", cl, "(", cl, " p);\n"] where cl = identCat (normCat cat) {- **** Implementation (.C) File Methods **** -} --This makes the .C file by a similar method. mkCFile :: CF -> [(Cat,[Rule])] -> String mkCFile cf groups = concat [ header, prRender, concatMap prPrintFun eps, concatMap prShowFun eps, concatMap (prPrintData user) groups, printBasics, printTokens, concatMap (prShowData user) groups, showBasics, showTokens, footer ] where eps = allEntryPoints cf user = fst (unzip (tokenPragmas cf)) header = unlines [ "/*** BNFC-Generated Pretty Printer and Abstract Syntax Viewer ***/", "", "#include \"Printer.h\"", "#include ", "#include ", "#include ", "", "int _n_;", "char* buf_;", "int cur_;", "int buf_size;", "" ] printBasics = unlines [ "void ppInteger(Integer n, int i)", "{", " char tmp[16];", " sprintf(tmp, \"%d\", n);", " bufAppendS(tmp);", "}", "void ppDouble(Double d, int i)", "{", " char tmp[16];", " sprintf(tmp, \"%g\", d);", " bufAppendS(tmp);", "}", "void ppChar(Char c, int i)", "{", " bufAppendC('\\'');", " bufAppendC(c);", " bufAppendC('\\'');", "}", "void ppString(String s, int i)", "{", " bufAppendC('\\\"');", " bufAppendS(s);", " bufAppendC('\\\"');", "}", "void ppIdent(String s, int i)", "{", " renderS(s);", "}", "" ] printTokens = unlines [unlines [ "void pp" ++ t ++ "(String s, int i)", "{", " renderS(s);", "}", "" ] | t <- tokenNames cf ] showBasics = unlines [ "void shInteger(Integer i)", "{", " char tmp[16];", " sprintf(tmp, \"%d\", i);", " bufAppendS(tmp);", "}", "void shDouble(Double d)", "{", " char tmp[16];", " sprintf(tmp, \"%g\", d);", " bufAppendS(tmp);", "}", "void shChar(Char c)", "{", " bufAppendC('\\'');", " bufAppendC(c);", " bufAppendC('\\'');", "}", "void shString(String s)", "{", " bufAppendC('\\\"');", " bufAppendS(s);", " bufAppendC('\\\"');", "}", "void shIdent(String s)", "{", " bufAppendC('\\\"');", " bufAppendS(s);", " bufAppendC('\\\"');", "}", "" ] showTokens = unlines [unlines [ "void sh" ++ t ++ "(String s)", "{", " bufAppendC('\\\"');", " bufAppendS(s);", " bufAppendC('\\\"');", "}", "" ] | t <- tokenNames cf ] footer = unlines [ "void bufAppendS(const char* s)", "{", " int len = strlen(s);", " int n;", " while (cur_ + len > buf_size)", " {", " buf_size *= 2; /* Double the buffer size */", " resizeBuffer();", " }", " for(n = 0; n < len; n++)", " {", " buf_[cur_ + n] = s[n];", " }", " cur_ += len;", " buf_[cur_] = 0;", "}", "void bufAppendC(const char c)", "{", " if (cur_ == buf_size)", " {", " buf_size *= 2; /* Double the buffer size */", " resizeBuffer();", " }", " buf_[cur_] = c;", " cur_++;", " buf_[cur_] = 0;", "}", "void bufReset(void)", "{", " cur_ = 0;", " buf_size = BUFFER_INITIAL;", " resizeBuffer();", " memset(buf_, 0, buf_size);", "}", "void resizeBuffer(void)", "{", " char* temp = (char*) malloc(buf_size);", " if (!temp)", " {", " fprintf(stderr, \"Error: Out of memory while attempting to grow buffer!\\n\");", " exit(1);", " }", " if (buf_)", " {", " strncpy(temp, buf_, buf_size); /* peteg: strlcpy is safer, but not POSIX/ISO C. */", " free(buf_);", " }", " buf_ = temp;", "}", "char *buf_;", "int cur_, buf_size;", "" ] {- **** Pretty Printer Methods **** -} --An entry point to begin printing prPrintFun :: Cat -> String prPrintFun ep | normCat ep == ep = unlines [ "char* print" ++ ep' ++ "(" ++ ep' ++ " p)", "{", " _n_ = 0;", " bufReset();", " pp" ++ ep' ++ "(p, 0);", " return buf_;", "}" ] where ep' = identCat ep prPrintFun _ = "" --Generates methods for the Pretty Printer prPrintData :: [UserDef] -> (Cat, [Rule]) -> String prPrintData user (cat, rules) = if isList cat then unlines [ "void pp" ++ cl ++ "("++ cl +++ vname ++ ", int i)", "{", " while(" ++ vname ++ "!= 0)", " {", " if (" ++ vname ++ "->" ++ vname ++ "_ == 0)", " {", visitMember, optsep, " " ++ vname +++ "= 0;", " }", " else", " {", visitMember, " render" ++ sc ++ "(" ++ sep ++ ");", " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", " }", "}", "" ] --Not a list: else unlines [ "void pp" ++ cl ++ "(" ++ cl ++ " _p_, int _i_)", "{", " switch(_p_->kind)", " {", concatMap (prPrintRule user) rules, " default:", " fprintf(stderr, \"Error: bad kind field when printing " ++ cat ++ "!\\n\");", " exit(1);", " }", "}\n" ] where cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl visitMember = " pp" ++ ecl ++ "(" ++ vname ++ "->" ++ member ++ "_, 0);" (sc, sep) = if length sep' == 1 then ("C", "'" ++ escapeChars sep' ++ "'") else ("S", "\"" ++ escapeChars sep' ++ "\"") sep' = getCons rules optsep = if hasOneFunc rules then "" else (" render" ++ sc ++ "(" ++ sep ++ ");") --Pretty Printer methods for a rule. prPrintRule :: [UserDef] -> Rule -> String prPrintRule user r@(Rule fun c cats) | not (isCoercion fun) = unlines [ " case is_" ++ fun ++ ":", lparen, cats', rparen, " break;\n" ] where p = precRule r (lparen, rparen) = (" if (_i_ > " ++ (show p) ++ ") renderC(_L_PAREN);", " if (_i_ > " ++ (show p) ++ ") renderC(_R_PAREN);") cats' = (concatMap (prPrintCat user fun) (zip3 (fixOnes (numVars [] cats)) cats (map getPrec cats))) getPrec (Right s) = (0 :: Int) getPrec (Left c) = precCat c prPrintRule _ _ = "" --This goes on to recurse to the instance variables. prPrintCat :: [UserDef] -> String -> (Either Cat String, Either Cat String, Int) -> String prPrintCat user fnm (c,o,p) = case c of (Right t) -> " render" ++ sc ++ "(" ++ t' ++ ");\n" where (sc,t') = if length t == 1 then ("C", "'" ++ (escapeChars t) ++ "'") else ("S", "\"" ++ (escapeChars t) ++ "\"") (Left nt) -> if isBasic user nt then " pp" ++ (basicFunName nt) ++ "(_p_->u." ++ v ++ "_." ++ nt ++ ", " ++ (show p) ++ ");\n" else if nt == "#_" --Internal category then " /* Internal Category */\n" else " pp" ++ o' ++ "(_p_->u." ++ v ++ "_." ++ nt ++ ", " ++ (show p) ++ ");\n" where v = map toLower (identCat (normCat fnm)) o' = case o of Right x -> x Left x -> normCat (identCat x) {- **** Abstract Syntax Tree Printer **** -} --An entry point to begin printing prShowFun :: Cat -> String prShowFun ep | normCat ep == ep = unlines [ "char* show" ++ ep' ++ "(" ++ ep' ++ " p)", "{", " _n_ = 0;", " bufReset();", " sh" ++ ep' ++ "(p);", " return buf_;", "}" ] where ep' = identCat ep prShowFun _ = "" --This prints the functions for Abstract Syntax tree printing. prShowData :: [UserDef] -> (Cat, [Rule]) -> String prShowData user (cat, rules) = if isList cat then unlines [ "void sh" ++ cl ++ "("++ cl +++ vname ++ ")", "{", " while(" ++ vname ++ "!= 0)", " {", " if (" ++ vname ++ "->" ++ vname ++ "_)", " {", visitMember, " bufAppendS(\", \");", " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", " else", " {", visitMember, " " ++ vname ++ " = 0;", " }", " }", "}", "" ] --Not a list: else unlines [ "void sh" ++ cl ++ "(" ++ cl ++ " _p_)", "{", " switch(_p_->kind)", " {", concatMap (prShowRule user) rules, " default:", " fprintf(stderr, \"Error: bad kind field when showing " ++ cat ++ "!\\n\");", " exit(1);", " }", "}\n" ] where cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl visitMember = " sh" ++ ecl ++ "(" ++ vname ++ "->" ++ member ++ "_);" --Pretty Printer methods for a rule. prShowRule :: [UserDef] -> Rule -> String prShowRule user r@(Rule fun c cats) | not (isCoercion fun) = unlines [ " case is_" ++ fun ++ ":", lparen, " bufAppendS(\"" ++ fun ++ "\");\n", optspace, cats', rparen, " break;\n" ] where (optspace, lparen, rparen) = if allTerms cats then ("","","") else (" bufAppendC(' ');\n", " bufAppendC('(');\n"," bufAppendC(')');\n") cats' = if allTerms cats then "" else concat (insertSpaces (map (prShowCat user fun) (zip (fixOnes (numVars [] cats)) cats))) insertSpaces [] = [] insertSpaces (x:[]) = [x] insertSpaces (x:xs) = if x == "" then insertSpaces xs else (x : [" bufAppendC(' ');\n"]) ++ (insertSpaces xs) allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs prShowRule _ _ = "" --This goes on to recurse to the instance variables. prShowCat :: [UserDef] -> String -> (Either Cat String, Either Cat String) -> String prShowCat user fnm (c,o) = case c of (Right t) -> "" (Left nt) -> if isBasic user nt then " sh" ++ (basicFunName nt) ++ "(_p_->u." ++ v ++ "_." ++ nt ++ ");\n" else if nt == "#_" --Internal category then " /* Internal Category */\n" else if ((normCat nt) /= nt) then " sh" ++ o' ++ "(_p_->u." ++ v ++ "_." ++ nt ++ ");\n" else concat [ " bufAppendC('[');\n", " sh" ++ o' ++ "(_p_->u." ++ v ++ "_." ++ nt ++ ");\n", " bufAppendC(']');\n" ] where v = map toLower (identCat (normCat fnm)) o' = case o of Right x -> x Left x -> normCat (identCat x) {- **** Helper Functions Section **** -} --Just checks if something is a basic or user-defined type. --This is because you don't -> a basic non-pointer type. isBasic :: [UserDef] -> String -> Bool isBasic user v = if elem (init v) user' then True else if "integer_" `isPrefixOf` v then True else if "char_" `isPrefixOf` v then True else if "string_" `isPrefixOf` v then True else if "double_" `isPrefixOf` v then True else if "ident_" `isPrefixOf` v then True else False where user' = map (map toLower) user --The visit-function name of a basic type basicFunName :: String -> String basicFunName v = if "integer_" `isPrefixOf` v then "Integer" else if "char_" `isPrefixOf` v then "Char" else if "string_" `isPrefixOf` v then "String" else if "double_" `isPrefixOf` v then "Double" else if "ident_" `isPrefixOf` v then "Ident" else "Ident" --User-defined type --Just sets the coercion level for parentheses in the Pretty Printer. setI :: Int -> String setI n = "_i_ = " ++ (show n) ++ "; " --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) escapeChars (x:xs) = x : (escapeChars xs) --An extremely simple renderCer for terminals. prRender :: String prRender = unlines [ "/* You may wish to change the renderC functions */", "void renderC(Char c)", "{", " if (c == '{')", " {", " bufAppendC('\\n');", " indent();", " bufAppendC(c);", " _n_ = _n_ + 2;", " bufAppendC('\\n');", " indent();", " }", " else if (c == '(' || c == '[')", " bufAppendC(c);", " else if (c == ')' || c == ']')", " {", " backup();", " bufAppendC(c);", " bufAppendC(' ');", " }", " else if (c == '}')", " {", " _n_ = _n_ - 2;", " backup();", " backup();", " bufAppendC(c);", " bufAppendC('\\n\');", " indent();", " }", " else if (c == ',')", " {", " backup();", " bufAppendC(c);", " bufAppendC(' ');", " }", " else if (c == ';')", " {", " backup();", " bufAppendC(c);", " bufAppendC('\\n');", " indent();", " }", " else if (c == 0) return;", " else", " {", " bufAppendC(c);", " bufAppendC(' ');", " }", "}", "void renderS(String s)", "{", " if(strlen(s) > 0)", " {", " bufAppendS(s);", " bufAppendC(' ');", " }", "}", "void indent(void)", "{", " int n = _n_;", " while (n > 0)", " {", " bufAppendC(' ');", " n--;", " }", "}", "void backup(void)", "{", " if (buf_[cur_ - 1] == ' ')", " {", " buf_[cur_ - 1] = 0;", " cur_--;", " }", "}" ] BNFC-2.6.0.3/src/formats/haskell2/0000755000000000000000000000000012100475635014530 5ustar0000000000000000BNFC-2.6.0.3/src/formats/haskell2/MkSharedString.hs0000644000000000000000000000476112100475635017761 0ustar0000000000000000{- BNF Converter: Haskell string sharing Copyright (C) 2004-2007 Author: Björn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module MkSharedString where sharedString :: String -> Bool -> b -> String sharedString shareMod byteString _ = unlines $ if byteString then [ "module " ++ shareMod ++ " (shareString) where", "", "import Data.Map as M", "import Data.IORef", "import qualified Data.ByteString.Char8 as BS", "import System.IO.Unsafe (unsafePerformIO)", "", "{-# NOINLINE stringPoolRef #-}", "stringPoolRef :: IORef (M.Map BS.ByteString BS.ByteString)", "stringPoolRef = unsafePerformIO $ newIORef M.empty", "", "{-# NOINLINE shareString #-}", "shareString :: BS.ByteString -> BS.ByteString", "shareString s = unsafePerformIO $ do", " stringPool <- readIORef stringPoolRef", " case M.lookup s stringPool of", " Just s' -> return s'", " Nothing -> do let s' = BS.copy s", " writeIORef stringPoolRef $! M.insert s' s' stringPool", " return s'" ] else [ "module " ++ shareMod ++ " (shareString) where", "", "import Data.HashTable as H", "import System.IO.Unsafe (unsafePerformIO)", "", "{-# NOINLINE stringPool #-}", "stringPool :: HashTable String String", "stringPool = unsafePerformIO $ new (==) hashString", "", "{-# NOINLINE shareString #-}", "shareString :: String -> String", "shareString s = unsafePerformIO $ do", " mv <- H.lookup stringPool s", " case mv of", " Just s' -> return s'", " Nothing -> do", " H.insert stringPool s s", " return s" ] BNFC-2.6.0.3/src/formats/haskell2/HsOpts.hs0000644000000000000000000000516212100475635016310 0ustar0000000000000000module HsOpts where import Utils import Options type Options = SharedOptions alex1 opts = alexMode opts == Alex1 absFile, absFileM, alexFile, alexFileM, dviFile, composOpFile, composOpFileM, gfAbs, gfConc, happyFile, happyFileM, latexFile, errFile, errFileM, templateFile, templateFileM, printerFile, printerFileM, layoutFile, layoutFileM, psFile, tFile, tFileM :: Options -> String absFile = mkFile withLangAbs "Abs" "hs" absFileM = mkMod withLangAbs "Abs" alexFile = mkFile withLang "Lex" "x" alexFileM = mkMod withLang "Lex" happyFile = mkFile withLang "Par" "y" happyFileM = mkMod withLang "Par" latexFile = mkFile withLang "Doc" "tex" txtFile = mkFile withLang "Doc" "txt" templateFile = mkFile withLang "Skel" "hs" templateFileM = mkMod withLang "Skel" printerFile = mkFile withLang "Print" "hs" printerFileM = mkMod withLang "Print" dviFile = mkFile withLang "Doc" "dvi" psFile = mkFile withLang "Doc" "ps" gfAbs = mkFile withLangAbs "" "Abs.gf" gfConc = mkFile withLang "" "Conc.gf" tFile = mkFile withLang "Test" "hs" tFileM = mkMod withLang "Test" errFile = mkFile noLang "ErrM" "hs" errFileM = mkMod noLang "ErrM" shareFile = mkFile noLang "SharedString" "hs" shareFileM = mkMod noLang "SharedString" layoutFileM = mkMod withLang "Layout" layoutFile = mkFile withLang "Layout" "hs" cnfTablesFile = mkFile withLang "CnfTables" "hs" cnfTablesFileM= mkMod withLang "CnfTables" xmlFileM = mkMod withLang "XML" composOpFile = mkFile noLang "ComposOp" "hs" composOpFileM = mkMod noLang "ComposOp" noLang :: Options -> String -> String noLang _ name = name withLang :: Options -> String -> String withLang opts name = name ++ lang opts withLangAbs :: Options -> String -> String withLangAbs opts name = postp $ name ++ lang opts where postp nam = if multi opts then takeWhile (/='_') nam else nam pkgToDir :: String -> FilePath pkgToDir s = replace '.' pathSep s mkMod :: (Options -> String -> String) -> String -> Options -> String mkMod addLang name opts = pref ++ if inDir opts then lang opts ++ "." ++ name else addLang opts name where pref = maybe "" (++".") (inPackage opts) mkFile :: (Options -> String -> String) -> String -> String -> Options -> FilePath mkFile addLang name ext opts = pref ++ if inDir opts then lang opts ++ [pathSep] ++ name ++ ext' else addLang opts name ++ if null ext then "" else ext' where pref = maybe "" (\p->pkgToDir p++[pathSep]) (inPackage opts) ext' = if null ext then "" else "." ++ ext BNFC-2.6.0.3/src/formats/haskell2/RegToAlex.hs0000644000000000000000000000561612100475634016725 0ustar0000000000000000{- BNF Converter: Regular expression pretty printer Copyright (C) 2004 Author: BNF Converter, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module RegToAlex (printRegAlex) where -- modified from pretty-printer generated by the BNF converter import AbsBNF import Data.Char -- the top-level printing method printRegAlex :: Reg -> String printRegAlex = render . prt 0 -- you may want to change render and parenth render :: [String] -> String render = rend (0::Int) where rend i ss = case ss of "[" :ts -> cons "[" $ rend i ts "(" :ts -> cons "(" $ rend i ts t : "," :ts -> cons t $ space "," $ rend i ts t : ")" :ts -> cons t $ cons ")" $ rend i ts t : "]" :ts -> cons t $ cons "]" $ rend i ts t :ts -> space t $ rend i ts _ -> "" cons s t = s ++ t new i s = s space t s = if null s then t else t ++ " " ++ s parenth :: [String] -> [String] parenth ss = ["("] ++ ss ++ [")"] -- the printer class does the job class Print a where prt :: Int -> a -> [String] prtList :: [a] -> [String] prtList = concat . map (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = if isAlphaNum c then [[c]] else ['^':[c]] prtList s = map (concat . prt 0) s prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (concat [prt 2 reg0 , prt 3 reg]) RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg]) RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg]) RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]]) RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]]) ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]]) REps -> prPrec i 3 (["$"]) RChar c -> prPrec i 3 (concat [prt 0 c]) RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]]) RSeqs str -> prPrec i 2 (concat (map (prt 0) str)) RDigit -> prPrec i 3 (concat [["^d"]]) RLetter -> prPrec i 3 (concat [["^l"]]) RUpper -> prPrec i 3 (concat [["^c"]]) RLower -> prPrec i 3 (concat [["^s"]]) RAny -> prPrec i 3 (concat [["^u"]]) BNFC-2.6.0.3/src/formats/haskell2/CFtoAlex3.hs0000644000000000000000000003136112100475634016617 0ustar0000000000000000{- BNF Converter: Alex 3.0 Generator Copyright (C) 2012 Author: Antti-Juhani Kaijanaho Copyright (C) 2004 Author: Peter Gammie (C)opyright 2003, {aarne,markus,peteg} at cs dot chalmers dot se 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoAlex3 (cf2alex3) where import CF import Data.List -- For RegToAlex, see below. import AbsBNF import Data.Char cf2alex3 :: String -> String -> String -> Bool -> Bool -> CF -> String cf2alex3 name errMod shareMod shareStrings byteStrings cf = unlines $ concat $ intersperse [""] [ prelude name errMod shareMod shareStrings byteStrings, cMacros, rMacros cf, restOfAlex shareMod shareStrings byteStrings cf ] prelude :: String -> String -> String -> Bool -> Bool -> [String] prelude name errMod shareMod shareStrings byteStrings = [ "-- -*- haskell -*-", "-- This Alex file was machine-generated by the BNF converter", "{", "{-# OPTIONS -fno-warn-incomplete-patterns #-}", "module " ++ name ++ " where", "", -- "import " ++ errMod, if shareStrings then "import " ++ shareMod else "", if byteStrings then "import qualified Data.ByteString.Char8 as BS" else "", "import qualified Data.Bits", "import Data.Word (Word8)", "}", "" ] cMacros :: [String] cMacros = [ "$l = [a-zA-Z\\192 - \\255] # [\\215 \\247] -- isolatin1 letter FIXME", "$c = [A-Z\\192-\\221] # [\\215] -- capital isolatin1 letter FIXME", "$s = [a-z\\222-\\255] # [\\247] -- small isolatin1 letter FIXME", "$d = [0-9] -- digit", "$i = [$l $d _ '] -- identifier character", "$u = [\\0-\\255] -- universal: any character" ] rMacros :: CF -> [String] rMacros cf = let symbs = symbols cf in (if null symbs then [] else [ "@rsyms = -- symbols and non-identifier-like reserved words", " " ++ unwords (intersperse "|" (map mkEsc symbs)) ]) where mkEsc = unwords . esc esc s = if null a then rest else show a : rest where (a,r) = span isAlphaNum s rest = case r of [] -> [] (c:xs) -> s : esc xs where s = if isPrint c then ['\\',c] else '\\':show (ord c) restOfAlex :: String -> Bool -> Bool -> CF -> [String] restOfAlex shareMod shareStrings byteStrings cf = [ ":-", lexComments (comments cf), "$white+ ;", pTSpec (symbols cf), userDefTokenTypes, ident, ifC "String" ("\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t)))* \\\"" ++ "{ tok (\\p s -> PT p (TL $ share $ unescapeInitTail s)) }"), ifC "Char" "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t]) \\' { tok (\\p s -> PT p (TC $ share s)) }", ifC "Integer" "$d+ { tok (\\p s -> PT p (TI $ share s)) }", ifC "Double" "$d+ \\. $d+ (e (\\-)? $d+)? { tok (\\p s -> PT p (TD $ share s)) }", "", "{", "", "tok f p s = f p s", "", "share :: "++stringType++" -> "++stringType, "share = " ++ if shareStrings then "shareString" else "id", "", "data Tok =", " TS !"++stringType++" !Int -- reserved words and symbols", " | TL !"++stringType++" -- string literals", " | TI !"++stringType++" -- integer literals", " | TV !"++stringType++" -- identifiers", " | TD !"++stringType++" -- double precision float literals", " | TC !"++stringType++" -- character literals", userDefTokenConstrs, " deriving (Eq,Show,Ord)", "", "data Token = ", " PT Posn Tok", " | Err Posn", " deriving (Eq,Show,Ord)", "", "tokenPos (PT (Pn _ l _) _ :_) = \"line \" ++ show l", "tokenPos (Err (Pn _ l _) :_) = \"line \" ++ show l", "tokenPos _ = \"end of file\"", "", "tokenPosn (PT p _) = p", "tokenPosn (Err p) = p", "tokenLineCol = posLineCol . tokenPosn", "posLineCol (Pn _ l c) = (l,c)", "mkPosToken t@(PT p _) = (posLineCol p, prToken t)", "", "prToken t = case t of", " PT _ (TS s _) -> s", " PT _ (TL s) -> s", " PT _ (TI s) -> s", " PT _ (TV s) -> s", " PT _ (TD s) -> s", " PT _ (TC s) -> s", userDefTokenPrint, "", "data BTree = N | B "++stringType++" Tok BTree BTree deriving (Show)", "", "eitherResIdent :: ("++stringType++" -> Tok) -> "++stringType++" -> Tok", "eitherResIdent tv s = treeFind resWords", " where", " treeFind N = tv s", " treeFind (B a t left right) | s < a = treeFind left", " | s > a = treeFind right", " | s == a = t", "", "resWords = " ++ (show $ sorted2tree $ cfTokens $ cf), " where b s n = let bs = "++stringPack++" s", " in B bs (TS bs n)", "", "unescapeInitTail :: "++stringType++" -> "++stringType++"", "unescapeInitTail = "++stringPack++" . unesc . tail . "++stringUnpack++" where", " unesc s = case s of", " '\\\\':c:cs | elem c ['\\\"', '\\\\', '\\\''] -> c : unesc cs", " '\\\\':'n':cs -> '\\n' : unesc cs", " '\\\\':'t':cs -> '\\t' : unesc cs", " '\"':[] -> []", " c:cs -> c : unesc cs", " _ -> []", "", "-------------------------------------------------------------------", "-- Alex wrapper code.", "-- A modified \"posn\" wrapper.", "-------------------------------------------------------------------", "", "data Posn = Pn !Int !Int !Int", " deriving (Eq, Show,Ord)", "", "alexStartPos :: Posn", "alexStartPos = Pn 0 1 1", "", "alexMove :: Posn -> Char -> Posn", "alexMove (Pn a l c) '\\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)", "alexMove (Pn a l c) '\\n' = Pn (a+1) (l+1) 1", "alexMove (Pn a l c) _ = Pn (a+1) l (c+1)", "", "type Byte = Word8", "", "type AlexInput = (Posn, -- current position,", " Char, -- previous char", " [Byte], -- pending bytes on the current char", " "++stringType++") -- current input string", "", "tokens :: "++stringType++" -> [Token]", "tokens str = go (alexStartPos, '\\n', [], str)", " where", " go :: AlexInput -> [Token]", " go inp@(pos, _, _, str) =", " case alexScan inp 0 of", " AlexEOF -> []", " AlexError (pos, _, _, _) -> [Err pos]", " AlexSkip inp' len -> go inp'", " AlexToken inp' len act -> act pos ("++stringTake++" len str) : (go inp')", "", "alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)", "alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))", "alexGetByte (p, _, [], s) =", " case "++stringUncons++" s of", " "++stringNilP++" -> Nothing", " "++stringConsP++" ->", " let p' = alexMove p c", " (b:bs) = utf8Encode c", " in p' `seq` Just (b, (p', c, bs, s))", "", "alexInputPrevChar :: AlexInput -> Char", "alexInputPrevChar (p, c, bs, s) = c", "", " -- | Encode a Haskell String to a list of Word8 values, in UTF8 format.", "utf8Encode :: Char -> [Word8]", "utf8Encode = map fromIntegral . go . ord", " where", " go oc", " | oc <= 0x7f = [oc]", "", " | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6)", " , 0x80 + oc Data.Bits..&. 0x3f", " ]", "", " | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12)", " , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)", " , 0x80 + oc Data.Bits..&. 0x3f", " ]", " | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18)", " , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)", " , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)", " , 0x80 + oc Data.Bits..&. 0x3f", " ]", "}" ] where (stringType,stringTake,stringUncons,stringPack,stringUnpack,stringNilP,stringConsP) | byteStrings = ("BS.ByteString", "BS.take", "BS.uncons", "BS.pack", "BS.unpack", "Nothing", "Just (c,s)") | otherwise = ("String", "take", "", "id", "id", "[]", "(c:s)" ) ifC cat s = if isUsedCat cf cat then s else "" lexComments ([],[]) = [] lexComments (xs,s1:ys) = '\"' : s1 ++ "\"" ++ " [.]* ; -- Toss single line comments\n" ++ lexComments (xs, ys) lexComments (([l1,l2],[r1,r2]):xs,[]) = concat $ [ ('\"':l1:l2:"\" ([$u # \\"), -- FIXME quotes or escape? (l2:"] | \\"), (r1:" [$u # \\"), (r2:"])* (\""), (r1:"\")+ \""), (r2:"\" ; \n"), lexComments (xs, []) ] lexComments ((_:xs),[]) = lexComments (xs,[]) --- lexComments (xs,(_:ys)) = lexComments (xs,ys) -- tokens consisting of special symbols pTSpec [] = "" pTSpec _ = "@rsyms { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }" userDefTokenTypes = unlines $ [printRegAlex exp ++ " { tok (\\p s -> PT p (eitherResIdent (T_" ++ name ++ " . share) s)) }" | (name,exp) <- tokenPragmas cf] userDefTokenConstrs = unlines $ [" | T_" ++ name ++ " !"++stringType | (name,_) <- tokenPragmas cf] userDefTokenPrint = unlines $ [" PT _ (T_" ++ name ++ " s) -> s" | (name,_) <- tokenPragmas cf] ident = "$l $i* { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }" --ifC "Ident" " ::= ^l ^i* { ident p = PT p . eitherResIdent TV }" data BTree = N | B String Int BTree BTree instance Show BTree where showsPrec _ N = showString "N" showsPrec n (B s k l r) = wrap (showString "b " . shows s . showChar ' '. shows k . showChar ' ' . showsPrec 1 l . showChar ' ' . showsPrec 1 r) where wrap f = if n > 0 then showChar '(' . f . showChar ')' else f sorted2tree :: [(String,Int)] -> BTree sorted2tree [] = N sorted2tree xs = B x n (sorted2tree t1) (sorted2tree t2) where (t1,((x,n):t2)) = splitAt (length xs `div` 2) xs ------------------------------------------------------------------- -- Inlined version of @RegToAlex@. -- Syntax has changed... ------------------------------------------------------------------- -- modified from pretty-printer generated by the BNF converter -- the top-level printing method printRegAlex :: Reg -> String printRegAlex = render . prt 0 -- you may want to change render and parenth render :: [String] -> String render = rend 0 where rend :: Int -> [String] -> String rend i ss = case ss of "[" :ts -> cons "[" $ rend i ts "(" :ts -> cons "(" $ rend i ts t : "," :ts -> cons t $ space "," $ rend i ts t : ")" :ts -> cons t $ cons ")" $ rend i ts t : "]" :ts -> cons t $ cons "]" $ rend i ts t :ts -> space t $ rend i ts _ -> "" cons s t = s ++ t new i s = s space t s = if null s then t else t ++ " " ++ s parenth :: [String] -> [String] parenth ss = ["("] ++ ss ++ [")"] -- the printer class does the job class Print a where prt :: Int -> a -> [String] prtList :: [a] -> [String] prtList = concat . map (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = if isAlphaNum c then [[c]] else ['\\':[c]] prtList s = map (concat . prt 0) s prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (concat [prt 2 reg0 , prt 3 reg]) RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg]) RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg]) RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]]) RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]]) ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]]) REps -> prPrec i 3 (["$"]) RChar c -> prPrec i 3 (concat [prt 0 c]) RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]]) RSeqs str -> prPrec i 2 (concat (map (prt 0) str)) RDigit -> prPrec i 3 (concat [["$d"]]) RLetter -> prPrec i 3 (concat [["$l"]]) RUpper -> prPrec i 3 (concat [["$c"]]) RLower -> prPrec i 3 (concat [["$s"]]) RAny -> prPrec i 3 (concat [["$u"]]) BNFC-2.6.0.3/src/formats/haskell2/CFtoHappy.hs0000644000000000000000000002270512100475634016726 0ustar0000000000000000{- BNF Converter: Happy Generator Copyright (C) 2004 Author: Markus Forberg, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoHappy ( cf2HappyS -- cf2HappyS :: CF -> CFCat -> String ) where import CF --import Lexer import Data.List (intersperse, sort) import Data.Char import Options (HappyMode(..)) -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String -- default naming moduleName = "HappyParser" tokenName = "Token" -- Happy mode cf2HappyS :: String -> String -> String -> String -> HappyMode -> Bool -> CF -> String ---- cf2HappyS :: String -> CF -> String cf2HappyS = cf2Happy -- The main function, that given a CF and a CFCat to parse according to, -- generates a happy module. cf2Happy name absName lexName errName mode byteStrings cf = unlines [header name absName lexName errName mode byteStrings, declarations mode (allEntryPoints cf), tokens (cfTokens cf), specialToks cf, delimiter, specialRules byteStrings cf, prRules (rulesForHappy cf), finalize byteStrings cf] -- construct the header. header :: String -> String -> String -> String -> HappyMode -> Bool -> String header modName absName lexName errName mode byteStrings = unlines ["-- This Happy file was machine-generated by the BNF converter", "{", "{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}", case mode of Standard -> "module " ++ modName ++ " where" GLR -> "-- module name filled in by Happy", "import " ++ absName, "import " ++ lexName, "import " ++ errName, if byteStrings then "import qualified Data.ByteString.Char8 as BS" else "", "}" ] {- ---- cf2Happy :: String -> CF -> String cf2Happy name cf = unlines [header name, declarations (allEntryPoints cf), tokens (cfTokens cf), specialToks cf, delimiter, specialRules cf, prRules (rulesForHappy cf), finalize cf] -- construct the header. header :: String -> String header name = unlines ["-- This Happy file was machine-generated by the BNF converter", "{", "module Par" ++ name ++ " where", "import Abs"++name, "import Lex"++name, "import ErrM", "}" ] -} -- The declarations of a happy file. declarations :: HappyMode -> [NonTerminal] -> String declarations mode ns = unlines [generateP ns, case mode of Standard -> "-- no lexer declaration" GLR -> "%lexer { myLexer } { Err _ }", "%monad { Err } { thenM } { returnM }", "%tokentype { " ++ tokenName ++ " }"] where generateP [] = [] generateP (n:ns) = concat ["%name p",n'," ",n',"\n",generateP ns] where n' = identCat n -- The useless delimiter symbol. delimiter :: String delimiter = "\n%%\n" -- Generate the list of tokens and their identifiers. tokens :: [(String,Int)] -> String tokens toks = "%token \n" ++ prTokens toks where prTokens [] = [] prTokens ((t,k):tk) = " " ++ (convert t) ++ " { " ++ oneTok t k ++ " }\n" ++ prTokens tk oneTok t k = "PT _ (TS _ " ++ show k ++ ")" -- Happy doesn't allow characters such as åäö to occur in the happy file. This -- is however not a restriction, just a naming paradigm in the happy source file. convert :: String -> String convert "\\" = concat ['\'':"\\\\","\'"] convert xs = concat ['\'':(escape xs),"\'"] where escape [] = [] escape ('\'':xs) = '\\':'\'':escape xs escape (x:xs) = x:escape xs rulesForHappy :: CF -> Rules rulesForHappy cf = map mkOne $ ruleGroups cf where mkOne (cat,rules) = constructRule cf rules cat -- For every non-terminal, we construct a set of rules. A rule is a sequence of -- terminals and non-terminals, and an action to be performed -- As an optimization, a pair of list rules [C] ::= "" | C k [C] -- is left-recursivized into [C] ::= "" | [C] C k. -- This could be generalized to cover other forms of list rules. constructRule :: CF -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule cf rules nt = (nt,[(p,generateAction nt (revF b r) m) | r0 <- rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True,revSepListRule r0) else (False,r0), let (p,m) = generatePatterns cf r]) where revF b r = if b then ("flip " ++ funRule r) else (underscore $ funRule r) revs = reversibleCats cf underscore f | isDefinedRule f = f ++ "_" | otherwise = f -- Generates a string containing the semantic action. -- An action can for example be: Sum $1 $2, that is, construct an AST -- with the constructor Sum applied to the two metavariables $1 and $2. generateAction :: NonTerminal -> Fun -> [MetaVar] -> Action generateAction nt f ms = unwords $ (if isCoercion f then [] else [f]) ++ ms -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: CF -> Rule -> (Pattern,[MetaVar]) generatePatterns cf r = case rhsRule r of [] -> ("{- empty -}",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> identCat c Right s -> convert s metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 ::Int ..] its] revIf c m = if (not (isConsFun (funRule r)) && elem c revs) then ("(reverse " ++ m ++ ")") else m -- no reversal in the left-recursive Cons rule itself revs = reversibleCats cf -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. prRules :: Rules -> String prRules = unlines . map prOne where prOne (nt,[]) = [] -- nt has only internal use prOne (nt,((p,a):ls)) = unwords [nt', "::", "{", normCat nt, "}\n" ++ nt', ":" , p, "{", a, "}", "\n" ++ pr ls] ++ "\n" where nt' = identCat nt pr [] = [] pr ((p,a):ls) = unlines [(concat $ intersperse " " [" |", p, "{", a , "}"])] ++ pr ls -- Finally, some haskell code. finalize :: Bool -> CF -> String finalize byteStrings cf = unlines $ [ "{", "\nreturnM :: a -> Err a", "returnM = return", "\nthenM :: Err a -> (a -> Err b) -> Err b", "thenM = (>>=)", "\nhappyError :: [" ++ tokenName ++ "] -> Err a", "happyError ts =", " Bad $ \"syntax error at \" ++ tokenPos ts ++ ", " case ts of", " [] -> []", " [Err _] -> \" due to lexer error\"", " _ -> \" before \" ++ unwords (map ("++stringUnpack++" . prToken) (take 4 ts))", "", "myLexer = tokens" ] ++ definedRules cf ++ [ "}" ] where stringUnpack | byteStrings = "BS.unpack" | otherwise = "id" definedRules cf = [ mkDef f xs e | FunDef f xs e <- pragmasOfCF cf ] where mkDef f xs e = unwords $ (f ++ "_") : xs' ++ ["=", show e'] where xs' = map (++"_") xs e' = underscore e underscore (App x es) | isLower $ head x = App (x ++ "_") $ map underscore es | otherwise = App x $ map underscore es underscore e = e -- aarne's modifs 8/1/2002: -- Markus's modifs 11/02/2002 -- GF literals specialToks :: CF -> String specialToks cf = unlines $ (map aux (literals cf)) ++ ["L_err { _ }"] where aux cat = case cat of "Ident" -> "L_ident { PT _ (TV $$) }" "String" -> "L_quoted { PT _ (TL $$) }" "Integer" -> "L_integ { PT _ (TI $$) }" "Double" -> "L_doubl { PT _ (TD $$) }" "Char" -> "L_charac { PT _ (TC $$) }" own -> "L_" ++ own ++ " { PT _ (T_" ++ own ++ " " ++ posn ++ ") }" where posn = if isPositionCat cf cat then "_" else "$$" specialRules :: Bool -> CF -> String specialRules byteStrings cf = unlines $ map aux (literals cf) where aux cat = case cat of "Ident" -> "Ident :: { Ident } : L_ident { Ident $1 }" "String" -> "String :: { String } : L_quoted { "++stringUnpack++" $1 }" "Integer" -> "Integer :: { Integer } : L_integ { (read ("++stringUnpack++" $1)) :: Integer }" "Double" -> "Double :: { Double } : L_doubl { (read ("++stringUnpack++" $1)) :: Double }" "Char" -> "Char :: { Char } : L_charac { (read ("++stringUnpack++" $1)) :: Char }" own -> own ++ " :: { " ++ own ++ "} : L_" ++ own ++ " { " ++ own ++ " ("++ posn ++ "$1)}" -- PCC: take "own" as type name? (manual says newtype) where posn = if isPositionCat cf cat then "mkPosToken " else "" stringUnpack | byteStrings = "BS.unpack" | otherwise = "" BNFC-2.6.0.3/src/formats/haskell2/CFtoTemplate.hs0000644000000000000000000001015412100475634017413 0ustar0000000000000000{- BNF Converter: Template Generator Copyright (C) 2004 Author: Markus Forberg 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoTemplate ( cf2Template ) where import CF import Data.Char import Data.List (delete) type ModuleName = String type Constructor = String cf2Template :: ModuleName -> ModuleName -> ModuleName -> CF -> String cf2Template skelName absName errName cf = unlines [ "module "++ skelName ++ " where\n", "-- Haskell module generated by the BNF converter\n", "import " ++ absName, "import " ++ errName, "type Result = Err String\n", "failure :: Show a => a -> Result", "failure x = Bad $ \"Undefined case: \" ++ show x\n", unlines $ map (\(s,xs) -> case_fun s (toArgs xs)) $ specialData cf ++ cf2data cf ] where toArgs [] = [] toArgs ((cons,args):xs) = (cons ++ " " ++ names False (map (checkRes . var) args) (1 :: Int)) : toArgs xs names _ [] _ = [] names b (x:xs) n | elem x xs = (x ++ show n) ++ " " ++ names True xs (n+1) | otherwise = (x ++ if b then show n else "") ++ " " ++ names b xs (if b then n+1 else n) {- toArgs ((cons,args):xs) = (cons ++ " " ++ names (map (checkRes . var) args) (0 :: Int)) : toArgs xs names [] _ = [] names (x:xs) n | elem x xs = (x ++ show n) ++ " " ++ names xs (n+1) | otherwise = x ++ " " ++ names xs n -} var ('[':xs) = var (init xs) ++ "s" var "Ident" = "id" var "Integer" = "n" var "String" = "str" var "Char" = "c" var "Double" = "d" var xs = map toLower xs checkRes s | elem s reservedHaskell = s ++ "'" | otherwise = s reservedHaskell = ["case","class","data","default","deriving","do","else","if", "import","in","infix","infixl","infixr","instance","let","module", "newtype","of","then","type","where","as","qualified","hiding"] {- ---- cf2Template :: ModuleName -> CF -> String cf2Template name cf = unlines [ "module Skel"++ name ++ " where\n", "-- Haskell module generated by the BNF converter\n", "import Abs" ++ name, "import ErrM", "type Result = Err String\n", "failure :: Show a => a -> Result", "failure x = Bad $ \"Undefined case: \" ++ show x\n", unlines $ map (\(s,xs) -> case_fun s (toArgs xs)) $ specialData cf ++ cf2data cf ] where toArgs [] = [] toArgs ((cons,args):xs) = (cons ++ " " ++ names False (map (checkRes . var) args) (1 :: Int)) : toArgs xs names _ [] _ = [] names b (x:xs) n | elem x xs = (x ++ show n) ++ " " ++ names True xs (n+1) | otherwise = (x ++ if b then show n else "") ++ " " ++ names b xs (if b then n+1 else n) var ('[':xs) = var (init xs) ++ "s" var "Ident" = "id" var "Integer" = "n" var "String" = "str" var "Char" = "c" var "Double" = "d" var xs = map toLower xs checkRes s | elem s reservedHaskell = s ++ "'" | otherwise = s reservedHaskell = ["case","class","data","default","deriving","do","else","if", "import","in","infix","infixl","infixr","instance","let","module", "newtype","of","then","type","where","as","qualified","hiding"] -} case_fun :: Cat -> [Constructor] -> String case_fun cat xs = unlines $ ["trans" ++ cat ++ " :: " ++ cat ++ " -> Result", "trans" ++ cat ++ " x = case x of", unlines $ map (\s -> " " ++ s ++ " -> " ++ "failure x") xs] BNFC-2.6.0.3/src/formats/haskell2/CFtoLayout.hs0000644000000000000000000002511712100475634017122 0ustar0000000000000000{- BNF Converter: Layout handling Generator Copyright (C) 2004 Author: Aarne Ranta Copyright (C) 2005 Bjorn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoLayout where import Data.List (sort) import CF layoutOpen = "{" layoutClose = "}" layoutSep = ";" cf2Layout :: Bool -> Bool -> String -> String -> CF -> String cf2Layout alex1 inDir layName lexName cf = let (top,lay,stop) = layoutPragmas cf in unlines $ [ "module " ++ layName ++ " where", "", "import " ++ lexName, if alex1 then "import Alex" else "", "", "import Data.Maybe (isNothing, fromJust)", "", "-- Generated by the BNF Converter", "", "-- local parameters", "", "topLayout = " ++ show top, "layoutWords = " ++ show lay, "layoutStopWords = " ++ show stop, "", "-- layout separators", "", "layoutOpen = " ++ show layoutOpen, "layoutClose = " ++ show layoutClose, "layoutSep = " ++ show layoutSep, "", "-- | Replace layout syntax with explicit layout tokens.", "resolveLayout :: Bool -- ^ Whether to use top-level layout.", " -> [Token] -> [Token]", "resolveLayout tp = res Nothing [if tl then Implicit 1 else Explicit]", " where", " -- Do top-level layout if the function parameter and the grammar say so.", " tl = tp && topLayout", "", " res :: Maybe Token -- ^ The previous token, if any.", " -> [Block] -- ^ A stack of layout blocks.", " -> [Token] -> [Token]", "", " -- The stack should never be empty.", " res _ [] ts = error $ \"Layout error: stack empty. Tokens: \" ++ show ts", "", " res _ st (t0:ts)", " -- We found an open brace in the input,", " -- put an explicit layout block on the stack.", " -- This is done even if there was no layout word,", " -- to keep opening and closing braces.", " | isLayoutOpen t0 = moveAlong (Explicit:st) [t0] ts", "", " res _ st (t0:ts)", " -- Start a new layout block if the first token is a layout word", " | isLayout t0 =", " case ts of", " -- Explicit layout, just move on. The case above", " -- will push an explicit layout block.", " t1:_ | isLayoutOpen t1 -> moveAlong st [t0] ts", " -- at end of file, the start column doesn't matter", " _ -> let col = if null ts then column t0 else column (head ts)", " -- insert an open brace after the layout word", " b:ts' = addToken (nextPos t0) layoutOpen ts", " -- save the start column", " st' = Implicit col:st ", " in moveAlong st' [t0,b] ts'", "", " -- If we encounter a closing brace, exit the first explicit layout block.", " | isLayoutClose t0 = ", " let st' = drop 1 (dropWhile isImplicit st)", " in if null st' ", " then error $ \"Layout error: Found \" ++ layoutClose ++ \" at (\" ", " ++ show (line t0) ++ \",\" ++ show (column t0) ", " ++ \") without an explicit layout block.\"", " else moveAlong st' [t0] ts", "", " -- We are in an implicit layout block", " res pt st@(Implicit n:ns) (t0:ts)", "", " -- End of implicit block by a layout stop word", " | isStop t0 = ", " -- Exit the current block and all implicit blocks ", " -- more indented than the current token", " let (ebs,ns') = span (`moreIndent` column t0) ns", " moreIndent (Implicit x) y = x > y", " moreIndent Explicit _ = False", " -- the number of blocks exited", " b = 1 + length ebs", " bs = replicate b layoutClose", " -- Insert closing braces after the previous token.", " (ts1,ts2) = splitAt (1+b) $ addTokens (afterPrev pt) bs (t0:ts)", " in moveAlong ns' ts1 ts2", "", " -- End of an implicit layout block", " | newLine && column t0 < n = ", " -- Insert a closing brace after the previous token.", " let b:t0':ts' = addToken (afterPrev pt) layoutClose (t0:ts)", " -- Repeat, with the current block removed from the stack", " in moveAlong ns [b] (t0':ts')", "", " -- Encounted a new line in an implicit layout block.", " | newLine && column t0 == n = ", " -- Insert a semicolon after the previous token.", " -- unless we are the beginning of the file,", " -- or the previous token is a semicolon or open brace.", " if isNothing pt || isTokenIn [layoutSep,layoutOpen] (fromJust pt) ", " then moveAlong st [t0] ts", " else let b:t0':ts' = addToken (afterPrev pt) layoutSep (t0:ts)", " in moveAlong st [b,t0'] ts'", " where newLine = case pt of", " Nothing -> True", " Just t -> line t /= line t0", "", " -- Nothing to see here, move along.", " res _ st (t:ts) = moveAlong st [t] ts", "", " -- At EOF: skip explicit blocks.", " res (Just t) (Explicit:bs) [] | null bs = []", " | otherwise = res (Just t) bs []", "", " -- If we are using top-level layout, insert a semicolon after", " -- the last token, if there isn't one already", " res (Just t) [Implicit n] []", " | isTokenIn [layoutSep] t = []", " | otherwise = addToken (nextPos t) layoutSep []", "", " -- At EOF in an implicit, non-top-level block: close the block", " res (Just t) (Implicit n:bs) [] =", " let c = addToken (nextPos t) layoutClose []", " in moveAlong bs c []", "", " -- This should only happen if the input is empty.", " res Nothing st [] = []", "", " -- | Move on to the next token.", " moveAlong :: [Block] -- ^ The layout stack.", " -> [Token] -- ^ Any tokens just processed.", " -> [Token] -- ^ the rest of the tokens.", " -> [Token]", " moveAlong st [] ts = error $ \"Layout error: moveAlong got [] as old tokens\"", " moveAlong st ot ts = ot ++ res (Just $ last ot) st ts", "", "data Block = Implicit Int -- ^ An implicit layout block with its start column.", " | Explicit ", " deriving Show", "", "type Position = Posn", "", "-- | Check if s block is implicit.", "isImplicit :: Block -> Bool", "isImplicit (Implicit _) = True", "isImplicit _ = False", "", "-- | Insert a number of tokens at the begninning of a list of tokens.", "addTokens :: Position -- ^ Position of the first new token.", " -> [String] -- ^ Token symbols.", " -> [Token] -- ^ The rest of the tokens. These will have their", " -- positions updated to make room for the new tokens .", " -> [Token] ", "addTokens p ss ts = foldr (addToken p) ts ss", "", "-- | Insert a new symbol token at the begninning of a list of tokens.", "addToken :: Position -- ^ Position of the new token.", " -> String -- ^ Symbol in the new token.", " -> [Token] -- ^ The rest of the tokens. These will have their", " -- positions updated to make room for the new token.", " -> [Token]", "addToken p s ts = sToken p s : map (incrGlobal p (length s)) ts", "", "-- | Get the position immediately to the right of the given token.", "-- If no token is given, gets the first position in the file.", "afterPrev :: Maybe Token -> Position", "afterPrev = maybe (Pn 0 1 1) nextPos", "", "-- | Get the position immediately to the right of the given token.", "nextPos :: Token -> Position ", "nextPos t = Pn (g + s) l (c + s + 1) ", " where Pn g l c = position t", " s = tokenLength t", "", "-- | Add to the global and column positions of a token.", "-- The column position is only changed if the token is on", "-- the same line as the given position.", "incrGlobal :: Position -- ^ If the token is on the same line", " -- as this position, update the column position.", " -> Int -- ^ Number of characters to add to the position.", " -> Token -> Token", "incrGlobal (Pn _ l0 _) i (PT (Pn g l c) t) =", " if l /= l0 then PT (Pn (g + i) l c) t", " else PT (Pn (g + i) l (c + i)) t", "incrGlobal _ _ p = error $ \"cannot add token at \" ++ show p", "", "-- | Create a symbol token.", "sToken :: Position -> String -> Token", "sToken p s = PT p (TS s i)", " where", " i = case s of"] ++ [ " " ++ show s ++ " -> " ++ show i | (s, i) <- zip resws [1..] ] ++ [" _ -> error $ \"not a reserved word: \" ++ show s", "", "-- | Get the position of a token.", "position :: Token -> Position", "position t = case t of", " PT p _ -> p", " Err p -> p", "", "-- | Get the line number of a token.", "line :: Token -> Int", "line t = case position t of Pn _ l _ -> l", "", "-- | Get the column number of a token.", "column :: Token -> Int", "column t = case position t of Pn _ _ c -> c", "", "-- | Check if a token is one of the given symbols.", "isTokenIn :: [String] -> Token -> Bool", "isTokenIn ts t = case t of", " PT _ (TS r _) | elem r ts -> True", " _ -> False", "", "-- | Check if a word is a layout start token.", "isLayout :: Token -> Bool", "isLayout = isTokenIn layoutWords", "", "-- | Check if a token is a layout stop token.", "isStop :: Token -> Bool", "isStop = isTokenIn layoutStopWords", "", "-- | Check if a token is the layout open token.", "isLayoutOpen :: Token -> Bool", "isLayoutOpen = isTokenIn [layoutOpen]", "", "-- | Check if a token is the layout close token.", "isLayoutClose :: Token -> Bool", "isLayoutClose = isTokenIn [layoutClose]", "", "-- | Get the number of characters in the token.", "tokenLength :: Token -> Int", "tokenLength t = length $ prToken t", "" ] where resws = sort (reservedWords cf ++ symbols cf) BNFC-2.6.0.3/src/formats/haskell2/MkErrM.hs0000644000000000000000000000347712100475635016234 0ustar0000000000000000{- BNF Converter: Haskell error monad Copyright (C) 2004-2007 Author: Markus Forberg, Peter Gammie, Aarne Ranta, Björn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module MkErrM where errM :: String -> b -> String errM errMod _ = unlines [ "-- BNF Converter: Error Monad", "-- Copyright (C) 2004 Author: Aarne Ranta", "", "-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.", "module " ++ errMod ++ " where", "", "-- the Error monad: like Maybe type with error msgs", "", "import Control.Monad (MonadPlus(..), liftM)", "", "data Err a = Ok a | Bad String", " deriving (Read, Show, Eq, Ord)", "", "instance Monad Err where", " return = Ok", " fail = Bad", " Ok a >>= f = f a", " Bad s >>= f = Bad s", "", "instance Functor Err where", " fmap = liftM", "", "instance MonadPlus Err where", " mzero = Bad \"Err.mzero\"", " mplus (Bad _) y = y", " mplus x _ = x" ] BNFC-2.6.0.3/src/formats/haskell2/CFtoAlex.hs0000644000000000000000000001577412100475634016546 0ustar0000000000000000{- BNF Converter: Alex 1.1 Generator Copyright (C) 2004 Author: Markus Forberg, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoAlex (cf2alex) where import CF import RegToAlex import Data.List cf2alex :: String -> String -> CF -> String cf2alex name errMod cf = unlines $ concat $ intersperse [""] [ prelude name errMod, cMacros, rMacros cf, restOfAlex cf ] prelude :: String -> String -> [String] prelude name errMod = [ "-- This Alex file was machine-generated by the BNF converter", "%{", "module " ++ name ++ " where", "", "import Alex", "import " ++ errMod, "%}" ] {- ---- cf2alex :: String -> CF -> String cf2alex name cf = unlines $ concat $ intersperse [""] [ prelude name, cMacros, rMacros cf, restOfAlex cf ] prelude :: String -> [String] prelude name = [ "-- This Alex file was machine-generated by the BNF converter", "%{", "module Lex" ++ name ++ " where", "", "import Alex", "import ErrM", "%}" ] -} cMacros :: [String] cMacros = [ "{ ^l = [a-zA-Z^192-^255] # [^215 ^247]} -- isolatin1 letter", "{ ^c = [A-Z^192-^221] # [^215]} -- capital isolatin1 letter", "{ ^s = [a-z^222-^255] # [^247]} -- small isolatin1 letter", "{ ^d = [0-9] } -- digit", "{ ^i = [^l^d^'^_] } -- identifier character", "{ ^u = [^0-^255] } -- universal: any character" ] rMacros :: CF -> [String] rMacros cf = let symbs = symbols cf in (if null symbs then [] else [ "{ %s = -- reserved words consisting of special symbols", " " ++ unwords (intersperse "|" (map mkEsc symbs)), "}" ]) where mkEsc = unwords . map ( f . (:[])) f s = if all isSpec s then '^':s else s isSpec = flip elem "$+-*=<>[](){}!?.,;:^~|&%#/\\$_@\"" restOfAlex :: CF -> [String] restOfAlex cf = [ "\"tokens_lx\"/\"tokens_acts\":-", lexComments (comments cf), "<> ::= ^w+", pTSpec (symbols cf,[]), -- modif Markus 12/02 - 2002 userDefTokenTypes, identAndRes, ifC "String" " ::= ^\" ([^u # [^\"^\\^n]] | (^\\ (^\" | ^\\ | ^' | n | t)))* ^\"" ++ "%{ string p = PT p . TL . unescapeInitTail %}", ifC "Char" " ::= ^\' (^u # [^\'^\\] | ^\\ [^\\ ^\' n t]) ^' %{ char p = PT p . TC %}", ifC "Integer" " ::= ^d+ %{ int p = PT p . TI %}", ifC "Double" " ::= ^d+ ^. ^d+ (e (^-)? ^d+)? %{ double p = PT p . TD %}", "", "%{ ", "", "data Tok =", " TS String -- reserved words", " | TL String -- string literals", " | TI String -- integer literals", " | TV String -- identifiers", " | TD String -- double precision float literals", " | TC String -- character literals", userDefTokenConstrs, " deriving (Eq,Show)", "", "data Token = ", " PT Posn Tok", " | Err Posn", " deriving Show", "", "tokenPos (PT (Pn _ l _) _ :_) = \"line \" ++ show l", "tokenPos (Err (Pn _ l _) :_) = \"line \" ++ show l", "tokenPos _ = \"end of file\"", "", "posLineCol (Pn _ l c) = (l,c)", "mkPosToken t@(PT p _) = (posLineCol p, prToken t)", "", "prToken t = case t of", " PT _ (TS s) -> s", " PT _ (TI s) -> s", " PT _ (TV s) -> s", " PT _ (TD s) -> s", " PT _ (TC s) -> s", userDefTokenPrint, " _ -> show t", "", "tokens:: String -> [Token]", "tokens inp = scan tokens_scan inp", "", "tokens_scan:: Scan Token", "tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx", " where", " stop_act p \"\" = []", " stop_act p inp = [Err p]", "", "eitherResIdent :: (String -> Tok) -> String -> Tok", "eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where", " isResWord s = isInTree s $", " " ++ (show $ sorted2tree $ sort resws), "", "data BTree = N | B String BTree BTree deriving (Show)", "", "isInTree :: String -> BTree -> Bool", "isInTree x tree = case tree of", " N -> False", " B a left right", " | x < a -> isInTree x left", " | x > a -> isInTree x right", " | x == a -> True", "", "unescapeInitTail :: String -> String", "unescapeInitTail = unesc . tail where", " unesc s = case s of", " '\\\\':c:cs | elem c ['\\\"', '\\\\', '\\\''] -> c : unesc cs", " '\\\\':'n':cs -> '\\n' : unesc cs", " '\\\\':'t':cs -> '\\t' : unesc cs", " '\"':[] -> []", " c:cs -> c : unesc cs", " _ -> []", "%}" ] where ifC cat s = if isUsedCat cf cat then s else "" lexComments ([],[]) = [] lexComments (xs,s1:ys) = "<> ::= " ++ ('^':intersperse '^' s1) ++ " [.]* ^n\n" ++ lexComments (xs,ys) lexComments (([l1,l2],[r1,r2]):xs,[]) = concat $ [ "<> ::= ", ('^':l1:' ':'^':l2:" ([^u # ^"), (l2:"] | ^"), (r1:" [^u # ^"), (r2:"])* (^"), (r1:")+ ^"), (r2:"\n"), lexComments (xs,[]) ] lexComments ((_:xs),[]) = lexComments (xs,[]) --- lexComments (xs,(_:ys)) = lexComments (xs,ys) pTSpec ([],[]) = "" pTSpec xp = " ::= " ++ aux xp ++ "%{ pTSpec p = PT p . TS %}" aux (xs,[]) = " %s " aux ([],ys) = " %r " aux (xs,ys) = " %s | %r " resWs = "[" ++ concat (intersperse "," [show s | s <- resws]) ++ "]" --- show s can be strange for isolatin1 characters --- precompile to search tree! userDefTokenTypes = unlines $ [" ::= " ++ printRegAlex exp ++ "%{ mk_" ++ name ++ " p = PT p . eitherResIdent T_" ++ name ++ " %}" | (name,exp) <- tokenPragmas cf] userDefTokenConstrs = unlines $ [" | T_" ++ name ++ " String" | (name,_) <- tokenPragmas cf] userDefTokenPrint = unlines $ [" PT _ (T_" ++ name ++ " s) -> s" | (name,_) <- tokenPragmas cf] identAndRes = --This has to be there for Reserved Words. Michael " ::= ^l ^i* %{ ident p = PT p . eitherResIdent TV %}" --ifC "Ident" " ::= ^l ^i* %{ ident p = PT p . eitherResIdent TV %}" resws = reservedWords cf data BTree = N | B String BTree BTree deriving (Show) isInTree :: String -> BTree -> Bool isInTree x tree = case tree of N -> False B a left right | x < a -> isInTree x left | x > a -> isInTree x right | x == a -> True sorted2tree :: [String] -> BTree sorted2tree [] = N sorted2tree xs = B x (sorted2tree t1) (sorted2tree t2) where (t1,(x:t2)) = splitAt (length xs `div` 2) xs BNFC-2.6.0.3/src/formats/haskell2/ToCNF.hs0000644000000000000000000004071212100475634016000 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {- Copyright (C) 2012 Authors: Jean-Philippe Bernardy. 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {-# LANGUAGE OverloadedStrings #-} module ToCNF (generate, genTestFile, genBenchmark) where {- Construction of CYK tables. The algorithm follows: Lange, Martin; Leiß, Hans (2009), "To CNF or not to CNF? An Efficient Yet Presentable Version of the CYK Algorithm", Informatica Didactica -} import CF hiding (App,Exp) import HsOpts import Control.Monad.RWS import Control.Applicative hiding (Const) import qualified Data.Map as M import Data.List (nub,intercalate,sortBy,sort) import Data.Maybe (maybeToList) import Data.Function (on) import Data.Char (isAlphaNum,ord) import Data.String import Data.Pair import Text.PrettyPrint.HughesPJ hiding (first,(<>)) (f *** g) (a,b) = (f a, g b) second g = id *** g onRules f (CFG (exts,rules)) = CFG (exts,f rules) toCNF cf0 = (cf1,cf2,units,descriptions) where cf01@(CFG (exts01,_)) = funToExp . onRules delInternal $ cf0 (rules',descriptions) = toBin (rulesOfCF cf01) cf1 = CFG (exts01,rules') cf2 = delNull cf1 units = unitSet cf2 funToExp :: CFG Fun -> CFG Exp funToExp = fmap toExp delInternal = filter (not . isInternalRhs . rhsRule) where isInternalRhs (Left c:_) = c == internalCat isInternalRhs _ = False -------------------------------------------------------------- -- BIN: make sure no rule has more than 2 symbols on the rhs allocateCatName = do n <- get put (1+n) return $ show n toBin :: [Rul Exp] -> ([Rul Exp], CatDescriptions) toBin cf = (a,w) where (a,_,w) = runRWS (concat <$> forM cf toBinRul) () 0 type CatDescriptions = M.Map Cat Doc -- | Convert a rule into a number of equivalent rules with at most 2 -- symbols on the rhs. -- Also writes an explanation of what new categories are. toBinRul :: Rul Exp -> RWS () CatDescriptions Int [Rul Exp] toBinRul (Rule f cat rhs) | length rhs > 2 = do cat' <- allocateCatName r' <- toBinRul $ Rule f cat' p tell $ M.singleton cat' (int (length p) <> "-prefix of " <> prettyExp f <> " " <> parens (prettyRHS p)) return $ Rule (Con "($)") cat [Left cat',l] : r' where l = last rhs p = init rhs fun' = case l of Left _ -> Con "($)" -- in this case we have to apply the final argument to the partial result Right _ -> Con "const" -- in this case the 2nd argument must be ignored (it is not present in the result). toBinRul r = return [r] prettyRHS = hcat . punctuate " " . map (either text (quotes . text)) --------------------------- -- Fixpoint utilities x ∪ y = sort $ nub (x ++ y) lk cat nullset = maybe [] id (M.lookup cat nullset) type Set k x = M.Map k [x] fixpointOnGrammar :: (Show k, Show x,Ord k, Ord x) => String -> (Set k x -> Rul f -> Set k x) -> CFG f -> Set k x fixpointOnGrammar name f cf = case fixn 100 step M.empty of Left x -> error $ "Could not find fixpoint of " ++ name ++". Last iteration:\n" ++ show x Right x -> x where step curSet = M.unionsWith (∪) (map (f curSet) (rulesOfCF cf)) fixn :: Eq a => Int -> (a -> a) -> a -> Either a a fixn 0 f x = Left x fixn n f x = if x' == x then Right x else fixn (n-1) f x' where x' = f x ------------------------------------------------------- -- DEL : make sure no rule has 0 symbol on the rhs type Nullable = Set Cat Exp cross :: [[a]] -> [[a]] cross [] = [[]] cross (x:xs) = [y:ys | y <- x, ys <- cross xs] nullRule :: Nullable -> Rul Exp -> (Cat,[Exp]) nullRule nullset (Rule f c rhs) = (c, map (\xs -> (appMany f xs)) (cross (map nulls rhs))) where nulls (Right tok) = [] nulls (Left cat) = lk cat nullset nullable :: Nullable -> Rul Exp -> Bool nullable s = not . null . snd . nullRule s nullSet :: CFG Exp -> Nullable nullSet = fixpointOnGrammar "nullable" (\s r -> uncurry M.singleton (nullRule s r)) -- | Replace nullable occurences by nothing, and adapt the function consequently. delNullable :: Nullable -> Rul Exp -> [Rul Exp] delNullable nullset r@(Rule f cat rhs) = case rhs of [] -> [] [_] -> [r] [r1,r2] -> [r] ++ [Rule (app' f x) cat [r2] | x <- lk' r1] ++ [Rule (app2 (isCat r1) f x) cat [r1] | x <- lk' r2] _ -> error $ "Panic:" ++ show r ++ "should have at most two elements." where lk' (Right tok) = [] lk' (Left cat) = lk cat nullset delNull cf = onRules (concatMap (delNullable (nullSet cf))) cf --------------- -- UNIT type UnitRel cat = Set (Either cat String) (Exp,cat) -- (c,(f,c')) ∈ unitSet ⇒ f : c → c' unitSet :: CFG Exp -> UnitRel Cat unitSet = fixpointOnGrammar "unit set" unitRule unitRule unitSet (Rule f c [r]) = M.singleton r $ (f,c) : [(g `appl` f,c') | (g,c') <- lk (Left c) unitSet] where appl = case r of Left _ -> after Right _ -> app' unitRule _ _ = M.empty isUnitRule (Rule f c [r]) = True isUnitRule _ = False ------------------------ -- Left/Right occurences isOnLeft, isOnRight :: RHSEl -> Rul f -> Bool isOnLeft c (Rule f _ [c',_]) = c == c' isOnLeft _ _ = False isOnRight c (Rule f _ [_,c']) = c == c' isOnRight _ _ = False isEntryPoint cf el = either (`elem` allEntryPoints cf) (const False) el occurs :: (RHSEl -> Rul f -> Bool) -> RHSEl -> CFG f -> Bool occurs where_ el cf = any (where_ el) (rulesOfCF cf) splitLROn :: (a -> RHSEl) -> CFG f -> [a] -> Pair [a] splitLROn f cf xs = filt <*> pure xs where filt = filter (\c -> occurs isOnLeft (f c) cf || isEntryPoint cf (f c)) :/: filter (\c -> occurs isOnRight (f c) cf) isSpecial (Left ('@':'@':_)) = True isSpecial _ = False optim :: (a -> RHSEl) -> Pair [a] -> Pair [(a,Doc -> Doc)] optim f (x:/:y) = map modif x :/: map modif' y where modif a | isSpecial (f a) = (a,\x -> "(if not p then (" <> x <> ":) else id)") | otherwise = (a,rob) modif' a | isSpecial (f a) = (a,\x -> "(if p then (" <> x <> ":) else id)") | otherwise = (a,rob) rob x = "("<> x <> ":)" splitOptim f cf xs = optim f $ splitLROn f cf $ xs --------------------------- -- Error reporting -- leftOf C = ⋃ { {X} ∪ leftOf X | C ::= X B ∈ Grammar or C ::= X ∈ Grammar } leftRight pos s (Rule f c rhs) = M.singleton c (lkCat x s) where x = pos rhs lkCat (Right t) s = [Right t] lkCat (Left c) s = Left c:lk c s -- neighbors A B = ∃ A' B'. A ∈ rightOf A' ∧ B ∈ leftOf B neighborSet cf = map (second (nub . sort)) $ group' [(x',lkCat y leftSet) | Rule _ _ [x,y] <- rulesOfCF cf, x' <- lkCat x rightSet] where leftSet = fixpointOnGrammar "left set" (leftRight head) cf rightSet = fixpointOnGrammar "right set" (leftRight last) cf genNeighborSet cf = vcat ["neighbors " <> catTag x <> " = " <> ppList (map catTag y) | (x,y) <- neighborSet cf] $$ "neighbors _ = []" ppList = brackets . punctuate' ", " ------------------------- -- Code generation incomment x = "{-" <> x <> "-}" generate opts cf0 = render $ vcat [header opts ,genShowFunction cf0 ,genCatTags cf1 ,genDesc cf1 descriptions ,genNeighborSet cf1 ,genCombTable units (onRules (filter (not . isUnitRule)) cf) ,genTokTable units cf ,incomment $ vcat ["Normalised grammar:" ,text $ show cf ,"Unit relation:" ,prettyUnitSet units ] ] where (cf1,cf,units,descriptions) = toCNF cf0 class Pretty a where pretty :: a -> Doc instance (Pretty k, Pretty v) => Pretty (Set k v) where pretty s = sep [pretty k <> " --> " <> pretty v | (k,x) <- M.assocs s, v <- x] instance Pretty (Either Cat String) where pretty (Left x) = text x pretty (Right x) = quotes $ text x instance Pretty String where pretty = text prettyUnitSet units = vcat [prettyExp f <> " : " <> catTag cat <> " --> " <> text cat' | (cat,x) <- M.assocs units, (f,cat') <- x] header opts = vcat ["{-# LANGUAGE MagicHash, FlexibleInstances #-}" ,"module " <> text (cnfTablesFileM opts) <> " where" ,"import GHC.Prim" ,"import GHC.Exts" ,"import Control.Applicative hiding (Const)" ,"import Algebra.RingUtils" ,"import Parsing.Chart ()" ,"import " <> text (absFileM opts) ,"import " <> text (alexFileM opts) ,"import " <> text ( printerFileM opts) ,"readInteger :: String -> Integer" ,"readInteger = read" ,"readDouble :: String -> Double" ,"readDouble = read" ,"instance RingP [(CATEGORY,Any)] where" ," mul p a b = trav [map (app tx ty) l :/: map (app tx ty) r | (x,tx) <- a, (y,ty) <- b, let l:/:r = combine p x y]" ," where trav :: [Pair [a]] -> Pair [a]" ," trav [] = pure []" ," trav (x:xs) = (++) <$> x <*> trav xs" ," app tx ty (z,f) = (z, f tx ty)" ] punctuate' p = cat . punctuate p genShowFunction cf = hang "showAst (cat,ast) = case cat of " 6 (vcat [catTag (Left cat) <> " -> printTree ((unsafeCoerce# ast)::" <> text cat <> ")" | cat <- filter isDataCat $ allCats cf] $$ "_ -> \"Unprintable category\"") genCatTags :: CFG Exp -> Doc genCatTags cf = "data CATEGORY = " <> punctuate' "|" (map catTag (allSyms cf)) $$ " deriving (Eq,Ord,Show)" genDesc :: CFG Exp -> CatDescriptions -> Doc genDesc cf descs = vcat ["describe " <> catTag s <> " = " <> doubleQuotes (descOf s) | s <- allSyms cf] where descOf (Right x) = "token " <> text x descOf (Left x) = maybe (text x) id $ M.lookup x descs genCombTable :: UnitRel Cat -> CFG Exp -> Doc genCombTable units cf = "combine :: Bool -> CATEGORY -> CATEGORY -> Pair [(CATEGORY, Any -> Any -> Any)]" $$ genCombine units cf $$ "combine _ _ _ = pure []" allSyms :: CFG Exp -> [Either String String] allSyms cf = map Left (allCats cf ++ literals cf) ++ map (Right . fst) (cfTokens cf) ppPair (x,y) = parens $ x <> comma <> " " <> y unsafeCoerce' = app' (Con "unsafeCoerce#") type RHSEl = Either Cat String isCat (Right _) = False isCat (Left _) = True group0 :: Eq a => [(a,[b])] -> [(a,[b])] group0 [] = [] group0 ((a,bs):xs) = (a,bs ++ concatMap snd ys) : group0 zs where (ys,zs) = span (\x -> fst x == a) xs group' :: Ord a => [(a,[b])] -> [(a,[b])] group' = group0 . sortBy (compare `on` fst) prettyPair (x :/: y) = sep [x,":/:",y] prettyListFun xs = parens $ sep (map (<> "$") xs) <> "[]" genCombine :: UnitRel Cat -> CFG Exp -> Doc genCombine units cf = vcat $ map genEntry $ group' $ map (alt units) (rulesOfCF cf) where genEntry :: ((RHSEl,RHSEl),[(Cat,Exp)]) -> Doc genEntry ((r1,r2),cs) = "combine p " <> catTag r1 <> " " <> catTag r2 <> " = " <> prettyPair (genList <$> splitOptim (Left . fst) cf cs) mkLam body = "\\x y -> " <> body genList xs = prettyListFun [p (ppPair (catTag . Left $ x, mkLam . prettyExp . unsafeCoerce' $ y)) | ((x,y),p) <- xs] alt :: UnitRel Cat -> Rul Exp -> ((RHSEl,RHSEl),[(Cat,Exp)]) alt units (Rule f c [r1,r2]) = ((r1,r2),initial:others) where initial = (c, f `appMany` args) others = [(c', f' `app'` (f `appMany` args)) | (f',c') <- lk (Left c) units] args = map (unsafeCoerce' . Con) $ ["x"|isCat r1]++["y"|isCat r2] catTag :: Either String String -> Doc catTag (Left c) = "CAT_" <> text (concatMap escape c) catTag (Right t) = "TOK_" <> text (concatMap escape t) escape c | isAlphaNum c || c == '_' = [c] escape '[' = "" escape ']' = "_List" escape '{' = "OPEN_" escape '}' = "CLOS_" escape '@' = "BIN_" escape c = show $ ord c genTokTable :: UnitRel Cat -> CFG Exp -> Doc genTokTable units cf = "tokenToCats :: Bool -> Token -> Pair [(CATEGORY,Any)]" $$ vcat (map (genSpecEntry cf units) (tokInfo cf)) $$ vcat (map (genTokEntry cf units) (cfTokens cf)) $$ "tokenToCats p t = error (\"unknown token: \" ++ show t)" tokInfo cf = ("Char","TC",Con "head"): ("String","TL",Id):("Integer","TI",Con "readInteger"): ("Double","TD",Con "readDouble"): [("Ident","TV",Con "Ident")|hasIdent cf] ++ [(t,"T_" <> text t,(Con t)) | t <- tokenNames cf] genTokCommon cf xs = prettyPair (gen <$> splitOptim fst cf xs) where gen ys = prettyListFun [p (ppPair (catTag x,y)) | ((x,y),p) <- ys] genSpecEntry cf units (tokName,constrName,fun) = "tokenToCats p (PT (Pn _ l c) (" <> constrName <> " x)) = " <> genTokCommon cf xs where xs = map (second (prettyExp . (\f -> unsafeCoerce' (f `app'` tokArgs)))) $ (Left tokName, fun) : [(Left c,f `after` fun) | (f,c) <- lk (Left tokName) units] tokArgs | isPositionCat cf tokName = Con "((l,c),x)" | otherwise = Con "x" genTokEntry cf units (tok,x) = " -- " <> text tok $$ "tokenToCats p (PT posn (TS _ " <> int x <> ")) = " <> genTokCommon cf xs where xs = (Right tok, tokVal) : [(Left c,prettyExp (unsafeCoerce' f)) | (f,c) <- lk (Right tok) units] tokVal = "error" <> (text $ show $ "cannot access value of token: " ++ tok) ------------------------ -- Test file generation genTestFile opts cf = render $ vcat ["module Main where" ,"import " <> text ( alexFileM opts) ,"import " <> text ( cnfTablesFileM opts) ,"import Parsing.TestProgram" ,"main = mainTest showAst tokenToCats tokens tokenLineCol describe neighbors"] genBenchmark opts = render $ vcat ["import System.Environment ( getArgs )" ,"import "<> text ( alexFileM opts) <> " as Lexer" ,"import "<> text ( cnfTablesFileM opts) <> " as Parser" ,"import GHC.Exts" ,"import Parsing.Chart" ,"import Criterion.Main" ,"import Algebra.RingUtils" ,"import Control.Applicative" ,"type T = [(CATEGORY,Any)]" ,"pLGrammar :: [Pair T] -> MT2 T" ,"pLGrammar = mkTree" ,"main = do" ," f:_ <- getArgs" ," s <- readFile f" ," let ts = zipWith tokenToCats (cycle [False,True]) (Lexer.tokens s)" ," (ts1,x:ts2) = splitAt (length ts `div` 2) ts" ," cs = [mkTree ts1,mkTree' ts2]" ," work [c1,c2] = show $ map fst $ root $ mergein False c1 x c2" ," defaultMain [bench f $ nf work cs] -- note the hack!!!" ] --------------------------------- -- Management of expressions. -- Most of this is not strictly useful; its main purpose is to -- generate "nice-looking" semantic actions data Exp = Id -- identity function | Con String -- constructor or variable | App Exp Exp | Exp `After` Exp | App2 Exp Exp deriving (Eq,Ord) prettyExp Id = "id" prettyExp (Con x) = text x prettyExp (App f x) = prettyExp f <+> (parens $ prettyExp x) prettyExp (App2 f x) = "flip" <+> parens (prettyExp f) <+> parens (prettyExp x) prettyExp (f `After` g) = parens (prettyExp f) <> "." <> parens (prettyExp g) instance Show Exp where show = render . prettyExp -- | Apply in 2nd position if the flag is true, otherwise apply normally. app2 True f x = App2 f x app2 False f x = app' f x infixl `app'` app' :: Exp -> Exp -> Exp app' (f `After` g) x = app' f (app' g x) app' Id x = x app' (App2 f y) x = (f `app'` x) `app'` y app' (Con "($)") f = f -- app' (Con "const") f = f app' f x = App f x toExp f | isCoercion f = Id | otherwise = Con f after :: Exp -> Exp -> Exp after Id f = f after f Id = f after f g = f `After` g appMany f args = foldl app' f argsBNFC-2.6.0.3/src/formats/haskell2/CFtoAlex2.hs0000644000000000000000000002746712100475634016632 0ustar0000000000000000{- BNF Converter: Alex 2.0 Generator Copyright (C) 2004 Author: Peter Gammie 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} ------------------------------------------------------------------- -- | -- Module : CFtoAlex2 -- Copyright : (C)opyright 2003, {aarne,markus,peteg} at cs dot chalmers dot se -- License : GPL (see COPYING for details) -- -- Maintainer : {markus,aarne} at cs dot chalmers dot se -- Stability : alpha -- Portability : Haskell98 -- -- Hacked version of @CFtoAlex@ to cope with Alex2. -- ------------------------------------------------------------------- module CFtoAlex2 (cf2alex2) where import CF import Data.List -- For RegToAlex, see below. import AbsBNF import Data.Char cf2alex2 :: String -> String -> String -> Bool -> Bool -> CF -> String cf2alex2 name errMod shareMod shareStrings byteStrings cf = unlines $ concat $ intersperse [""] [ prelude name errMod shareMod shareStrings byteStrings, cMacros, rMacros cf, restOfAlex shareMod shareStrings byteStrings cf ] prelude :: String -> String -> String -> Bool -> Bool -> [String] prelude name errMod shareMod shareStrings byteStrings = [ "-- -*- haskell -*-", "-- This Alex file was machine-generated by the BNF converter", "{", "{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}", "module " ++ name ++ " where", "", -- "import " ++ errMod, if shareStrings then "import " ++ shareMod else "", if byteStrings then "import qualified Data.ByteString.Char8 as BS" else "", "}", "" ] cMacros :: [String] cMacros = [ "$l = [a-zA-Z\\192 - \\255] # [\\215 \\247] -- isolatin1 letter FIXME", "$c = [A-Z\\192-\\221] # [\\215] -- capital isolatin1 letter FIXME", "$s = [a-z\\222-\\255] # [\\247] -- small isolatin1 letter FIXME", "$d = [0-9] -- digit", "$i = [$l $d _ '] -- identifier character", "$u = [\\0-\\255] -- universal: any character" ] rMacros :: CF -> [String] rMacros cf = let symbs = symbols cf in (if null symbs then [] else [ "@rsyms = -- symbols and non-identifier-like reserved words", " " ++ unwords (intersperse "|" (map mkEsc symbs)) ]) where mkEsc = unwords . esc esc s = if null a then rest else show a : rest where (a,r) = span isAlphaNum s rest = case r of [] -> [] (c:xs) -> s : esc xs where s = if isPrint c then ['\\',c] else '\\':show (ord c) restOfAlex :: String -> Bool -> Bool -> CF -> [String] restOfAlex shareMod shareStrings byteStrings cf = [ ":-", lexComments (comments cf), "$white+ ;", pTSpec (symbols cf), userDefTokenTypes, ident, ifC "String" ("\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t)))* \\\"" ++ "{ tok (\\p s -> PT p (TL $ share $ unescapeInitTail s)) }"), ifC "Char" "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t]) \\' { tok (\\p s -> PT p (TC $ share s)) }", ifC "Integer" "$d+ { tok (\\p s -> PT p (TI $ share s)) }", ifC "Double" "$d+ \\. $d+ (e (\\-)? $d+)? { tok (\\p s -> PT p (TD $ share s)) }", "", "{", "", "tok f p s = f p s", "", "share :: "++stringType++" -> "++stringType, "share = " ++ if shareStrings then "shareString" else "id", "", "data Tok =", " TS !"++stringType++" !Int -- reserved words and symbols", " | TL !"++stringType++" -- string literals", " | TI !"++stringType++" -- integer literals", " | TV !"++stringType++" -- identifiers", " | TD !"++stringType++" -- double precision float literals", " | TC !"++stringType++" -- character literals", userDefTokenConstrs, " deriving (Eq,Show,Ord)", "", "data Token = ", " PT Posn Tok", " | Err Posn", " deriving (Eq,Show,Ord)", "", "tokenPos (PT (Pn _ l _) _ :_) = \"line \" ++ show l", "tokenPos (Err (Pn _ l _) :_) = \"line \" ++ show l", "tokenPos _ = \"end of file\"", "", "posLineCol (Pn _ l c) = (l,c)", "mkPosToken t@(PT p _) = (posLineCol p, prToken t)", "", "prToken t = case t of", " PT _ (TS s _) -> s", " PT _ (TL s) -> s", " PT _ (TI s) -> s", " PT _ (TV s) -> s", " PT _ (TD s) -> s", " PT _ (TC s) -> s", userDefTokenPrint, "", "data BTree = N | B "++stringType++" Tok BTree BTree deriving (Show)", "", "eitherResIdent :: ("++stringType++" -> Tok) -> "++stringType++" -> Tok", "eitherResIdent tv s = treeFind resWords", " where", " treeFind N = tv s", " treeFind (B a t left right) | s < a = treeFind left", " | s > a = treeFind right", " | s == a = t", "", "resWords = " ++ (show $ sorted2tree $ zip (sort resws) [1..]), " where b s n = let bs = "++stringPack++" s", " in B bs (TS bs n)", "", "unescapeInitTail :: "++stringType++" -> "++stringType++"", "unescapeInitTail = "++stringPack++" . unesc . tail . "++stringUnpack++" where", " unesc s = case s of", " '\\\\':c:cs | elem c ['\\\"', '\\\\', '\\\''] -> c : unesc cs", " '\\\\':'n':cs -> '\\n' : unesc cs", " '\\\\':'t':cs -> '\\t' : unesc cs", " '\"':[] -> []", " c:cs -> c : unesc cs", " _ -> []", "", "-------------------------------------------------------------------", "-- Alex wrapper code.", "-- A modified \"posn\" wrapper.", "-------------------------------------------------------------------", "", "data Posn = Pn !Int !Int !Int", " deriving (Eq, Show,Ord)", "", "alexStartPos :: Posn", "alexStartPos = Pn 0 1 1", "", "alexMove :: Posn -> Char -> Posn", "alexMove (Pn a l c) '\\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)", "alexMove (Pn a l c) '\\n' = Pn (a+1) (l+1) 1", "alexMove (Pn a l c) _ = Pn (a+1) l (c+1)", "", "type AlexInput = (Posn, -- current position,", " Char, -- previous char", " "++stringType++") -- current input string", "", "tokens :: "++stringType++" -> [Token]", "tokens str = go (alexStartPos, '\\n', str)", " where", " go :: AlexInput -> [Token]", " go inp@(pos, _, str) =", " case alexScan inp 0 of", " AlexEOF -> []", " AlexError (pos, _, _) -> [Err pos]", " AlexSkip inp' len -> go inp'", " AlexToken inp' len act -> act pos ("++stringTake++" len str) : (go inp')", "", "alexGetChar :: AlexInput -> Maybe (Char,AlexInput)", "alexGetChar (p, _, s) =", " case "++stringUncons++" s of", " "++stringNilP++" -> Nothing", " "++stringConsP++" ->", " let p' = alexMove p c", " in p' `seq` Just (c, (p', c, s))", "", "alexInputPrevChar :: AlexInput -> Char", "alexInputPrevChar (p, c, s) = c", "}" ] where (stringType,stringTake,stringUncons,stringPack,stringUnpack,stringNilP,stringConsP) | byteStrings = ("BS.ByteString", "BS.take", "BS.uncons", "BS.pack", "BS.unpack", "Nothing", "Just (c,s)") | otherwise = ("String", "take", "", "id", "id", "[]", "(c:s)" ) ifC cat s = if isUsedCat cf cat then s else "" lexComments ([],[]) = [] lexComments (xs,s1:ys) = '\"' : s1 ++ "\"" ++ " [.]* ; -- Toss single line comments\n" ++ lexComments (xs, ys) lexComments (([l1,l2],[r1,r2]):xs,[]) = concat $ [ ('\"':l1:l2:"\" ([$u # \\"), -- FIXME quotes or escape? (l2:"] | \\"), (r1:" [$u # \\"), (r2:"])* (\""), (r1:"\")+ \""), (r2:"\" ; \n"), lexComments (xs, []) ] lexComments ((_:xs),[]) = lexComments (xs,[]) --- lexComments (xs,(_:ys)) = lexComments (xs,ys) -- tokens consisting of special symbols pTSpec [] = "" pTSpec _ = "@rsyms { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }" userDefTokenTypes = unlines $ [printRegAlex exp ++ " { tok (\\p s -> PT p (eitherResIdent (T_" ++ name ++ " . share) s)) }" | (name,exp) <- tokenPragmas cf] userDefTokenConstrs = unlines $ [" | T_" ++ name ++ " !"++stringType | (name,_) <- tokenPragmas cf] userDefTokenPrint = unlines $ [" PT _ (T_" ++ name ++ " s) -> s" | (name,_) <- tokenPragmas cf] ident = "$l $i* { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }" --ifC "Ident" " ::= ^l ^i* { ident p = PT p . eitherResIdent TV }" resws = reservedWords cf ++ symbols cf data BTree = N | B String Int BTree BTree instance Show BTree where showsPrec _ N = showString "N" showsPrec n (B s k l r) = wrap (showString "b " . shows s . showChar ' '. shows k . showChar ' ' . showsPrec 1 l . showChar ' ' . showsPrec 1 r) where wrap f = if n > 0 then showChar '(' . f . showChar ')' else f sorted2tree :: [(String,Int)] -> BTree sorted2tree [] = N sorted2tree xs = B x n (sorted2tree t1) (sorted2tree t2) where (t1,((x,n):t2)) = splitAt (length xs `div` 2) xs ------------------------------------------------------------------- -- Inlined version of @RegToAlex@. -- Syntax has changed... ------------------------------------------------------------------- -- modified from pretty-printer generated by the BNF converter -- the top-level printing method printRegAlex :: Reg -> String printRegAlex = render . prt 0 -- you may want to change render and parenth render :: [String] -> String render = rend 0 where rend :: Int -> [String] -> String rend i ss = case ss of "[" :ts -> cons "[" $ rend i ts "(" :ts -> cons "(" $ rend i ts t : "," :ts -> cons t $ space "," $ rend i ts t : ")" :ts -> cons t $ cons ")" $ rend i ts t : "]" :ts -> cons t $ cons "]" $ rend i ts t :ts -> space t $ rend i ts _ -> "" cons s t = s ++ t new i s = s space t s = if null s then t else t ++ " " ++ s parenth :: [String] -> [String] parenth ss = ["("] ++ ss ++ [")"] -- the printer class does the job class Print a where prt :: Int -> a -> [String] prtList :: [a] -> [String] prtList = concat . map (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = if isAlphaNum c then [[c]] else ['\\':[c]] prtList s = map (concat . prt 0) s prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (concat [prt 2 reg0 , prt 3 reg]) RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg]) RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg]) RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]]) RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]]) ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]]) REps -> prPrec i 3 (["()"]) RChar c -> prPrec i 3 (concat [prt 0 c]) RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]]) RSeqs str -> prPrec i 2 (concat (map (prt 0) str)) RDigit -> prPrec i 3 (concat [["$d"]]) RLetter -> prPrec i 3 (concat [["$l"]]) RUpper -> prPrec i 3 (concat [["$c"]]) RLower -> prPrec i 3 (concat [["$s"]]) RAny -> prPrec i 3 (concat [["$u"]]) BNFC-2.6.0.3/src/formats/haskell2/HaskellTop.hs0000644000000000000000000002477512100475634017150 0ustar0000000000000000{- BNF Converter: Haskell main file Copyright (C) 2004 Author: Markus Forberg, Peter Gammie, Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module HaskellTop (makeAll, AlexMode(..)) where -- import Utils import Options import CF import CFtoHappy import CFtoAlex import CFtoAlex2 import CFtoAlex3 import CFtoLatex import CFtoTxt import CFtoAbstract import CFtoTemplate import CFtoPrinter import CFtoLayout import CFtoXML import HsOpts import ToCNF import MkErrM import MkSharedString import Utils import Data.Char import Data.Maybe (fromMaybe,maybe) import System.Exit (exitFailure) import Control.Monad(when) -- naming conventions makeAll :: Options -> CF -> IO () makeAll opts cf = do let absMod = absFileM opts lexMod = alexFileM opts parMod = happyFileM opts prMod = printerFileM opts layMod = layoutFileM opts errMod = errFileM opts shareMod = shareFileM opts do let dir = codeDir opts when (not (null dir)) $ do putStrLn $ "Creating directory " ++ dir prepareDir dir writeFileRep (absFile opts) $ cf2Abstract (byteStrings opts) absMod cf case alexMode opts of Alex1 -> do writeFileRep (alexFile opts) $ cf2alex lexMod errMod cf putStrLn " (Use Alex 1.1 to compile.)" Alex2 -> do writeFileRep (alexFile opts) $ cf2alex2 lexMod errMod shareMod (shareStrings opts) (byteStrings opts) cf putStrLn " (Use Alex 2.0 to compile.)" Alex3 -> do writeFileRep (alexFile opts) $ cf2alex3 lexMod errMod shareMod (shareStrings opts) (byteStrings opts) cf putStrLn " (Use Alex 3.0 to compile.)" writeFileRep (happyFile opts) $ cf2HappyS parMod absMod lexMod errMod (glr opts) (byteStrings opts) cf putStrLn " (Tested with Happy 1.15)" writeFileRep (latexFile opts) $ cfToLatex (lang opts) cf writeFileRep (txtFile opts) $ cfToTxt (lang opts) cf writeFileRep (templateFile opts) $ cf2Template (templateFileM opts) absMod errMod cf writeFileRep (printerFile opts) $ cf2Printer (byteStrings opts) prMod absMod cf when (hasLayout cf) $ writeFileRep (layoutFile opts) $ cf2Layout (alex1 opts) (inDir opts) layMod lexMod cf writeFileRep (tFile opts) $ testfile opts cf writeFileRep (errFile opts) $ errM errMod cf when (shareStrings opts) $ writeFileRep (shareFile opts) $ sharedString shareMod (byteStrings opts) cf when (make opts) $ writeFileRep "Makefile" $ makefile opts case xml opts of 2 -> makeXML (lang opts) True cf 1 -> makeXML (lang opts) False cf _ -> return () when (cnf opts) $ do writeFileRep (cnfTablesFile opts) $ ToCNF.generate opts cf writeFileRep "TestCNF.hs" $ ToCNF.genTestFile opts cf writeFileRep "BenchCNF.hs" $ ToCNF.genBenchmark opts codeDir :: Options -> FilePath codeDir opts = let pref = maybe "" pkgToDir (inPackage opts) dir = if inDir opts then lang opts else "" sep = if null pref || null dir then "" else [pathSep] in pref ++ sep ++ dir makefile :: Options -> String makefile opts = makeA where glr_params = if glr opts == GLR then "--glr --decode " else "" dir = let d = codeDir opts in if null d then "" else d ++ [pathSep] cd c = if null dir then c else "(cd " ++ dir ++ "; " ++ c ++ ")" makeA = unlines [ "all:", "\thappy -gca " ++ glr_params ++ happyFile opts, "\talex -g " ++ alexFile opts, "\t" ++ cd ("latex " ++ basename (latexFile opts) ++ "; " ++ "dvips " ++ basename (dviFile opts) ++ " -o " ++ basename (psFile opts)), "\tghc --make " ++ tFile opts ++ " -o " ++ mkFile withLang "Test" "" opts, "clean:", "\t-rm -f " ++ unwords (map (dir++) [ "*.log", "*.aux", "*.hi", "*.o", "*.dvi" ]), "\t-rm -f " ++ psFile opts, "distclean: clean", "\t-rm -f " ++ unwords [ mkFile withLang "Doc" "*" opts, mkFile withLang "Lex" "*" opts, mkFile withLang "Par" "*" opts, mkFile withLang "Layout" "*" opts, mkFile withLang "Skel" "*" opts, mkFile withLang "Print" "*" opts, mkFile withLang "Test" "*" opts, mkFile withLang "Abs" "*" opts, mkFile withLang "Test" "" opts, mkFile noLang "ErrM" "*" opts, mkFile noLang "SharedString" "*" opts, dir ++ lang opts ++ ".dtd", mkFile withLang "XML" "*" opts, "Makefile*" ], if null dir then "" else "\t-rmdir -p " ++ dir ] testfile :: Options -> CF -> String testfile opts cf = let lay = hasLayout cf use_xml = xml opts > 0 xpr = if use_xml then "XPrint a, " else "" use_glr = glr opts == GLR if_glr s = if use_glr then s else "" firstParser = if use_glr then "the_parser" else parserName parserName = 'p' : topType topType = firstEntry cf in unlines ["-- automatically generated by BNF Converter", "module Main where\n", "", "import System.IO ( stdin, hGetContents )", "import System.Environment ( getArgs, getProgName )", "", "import " ++ alexFileM opts, "import " ++ happyFileM opts, "import " ++ templateFileM opts, "import " ++ printerFileM opts, "import " ++ absFileM opts, if lay then ("import " ++ layoutFileM opts) else "", if use_xml then ("import " ++ xmlFileM opts) else "", if_glr "import Data.FiniteMap(FiniteMap, lookupFM, fmToList)", if_glr "import Data.Maybe(fromJust)", "import " ++ errFileM opts, "", if use_glr then "type ParseFun a = [[Token]] -> (GLRResult, GLR_Output (Err a))" else "type ParseFun a = [Token] -> Err a", "", "myLLexer = " ++ if lay then "resolveLayout True . myLexer" else "myLexer", "", "type Verbosity = Int", "", "putStrV :: Verbosity -> String -> IO ()", "putStrV v s = if v > 1 then putStrLn s else return ()", "", "runFile :: (" ++ xpr ++ if_glr "TreeDecode a, " ++ "Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO ()", "runFile v p f = putStrLn f >> readFile f >>= run v p", "", "run :: (" ++ xpr ++ if_glr "TreeDecode a, " ++ "Print a, Show a) => Verbosity -> ParseFun a -> String -> IO ()", if use_glr then run_glr else run_std use_xml, "", "showTree :: (Show a, Print a) => Int -> a -> IO ()", "showTree v tree", " = do", " putStrV v $ \"\\n[Abstract Syntax]\\n\\n\" ++ show tree", " putStrV v $ \"\\n[Linearized tree]\\n\\n\" ++ printTree tree", "", "main :: IO ()", "main = do args <- getArgs", " case args of", " [] -> hGetContents stdin >>= run 2 " ++ firstParser, " \"-s\":fs -> mapM_ (runFile 0 " ++ firstParser ++ ") fs", " fs -> mapM_ (runFile 2 " ++ firstParser ++ ") fs", "", if_glr $ "the_parser :: ParseFun " ++ topType, if_glr $ "the_parser = lift_parser " ++ parserName, if_glr $ "", if_glr $ lift_parser ] run_std xml = unlines [ "run v p s = let ts = myLLexer s in case p ts of" , " Bad s -> do putStrLn \"\\nParse Failed...\\n\"" , " putStrV v \"Tokens:\"" , " putStrV v $ show ts" , " putStrLn s" , " Ok tree -> do putStrLn \"\\nParse Successful!\"" , " showTree v tree" , if xml then " putStrV v $ \"\\n[XML]\\n\\n\" ++ printXML tree" else "" ] run_glr = unlines [ "run v p s" , " = let ts = map (:[]) $ myLLexer s" , " (raw_output, simple_output) = p ts in" , " case simple_output of" , " GLR_Fail major minor -> do" , " putStrLn major" , " putStrV v minor" , " GLR_Result df trees -> do" , " putStrLn \"\\nParse Successful!\"" , " case trees of" , " [] -> error \"No results but parse succeeded?\"" , " [Ok x] -> showTree v x" , " xs@(_:_) -> showSeveralTrees v xs" , " where" , " showSeveralTrees :: (Print b, Show b) => Int -> [Err b] -> IO ()" , " showSeveralTrees v trees" , " = sequence_ " , " [ do putStrV v (replicate 40 '-')" , " putStrV v $ \"Parse number: \" ++ show n" , " showTree v t" , " | (Ok t,n) <- zip trees [1..]" , " ]" ] lift_parser = unlines [ "type Forest = FiniteMap ForestId [Branch] -- omitted in ParX export." , "data GLR_Output a" , " = GLR_Result { pruned_decode :: (Forest -> Forest) -> [a]" , " , semantic_result :: [a]" , " }" , " | GLR_Fail { main_message :: String" , " , extra_info :: String" , " }" , "" , "lift_parser" , " :: (TreeDecode a, Show a, Print a)" , " => ([[Token]] -> GLRResult) -> ParseFun a" , "lift_parser parser ts" , " = let result = parser ts in" , " (\\o -> (result, o)) $" , " case result of" , " ParseError ts f -> GLR_Fail \"Parse failed, unexpected token(s)\\n\"" , " (\"Tokens: \" ++ show ts)" , " ParseEOF f -> GLR_Fail \"Parse failed, unexpected EOF\\n\"" , " (\"Partial forest:\\n\"" , " ++ unlines (map show $ fmToList f))" , " ParseOK r f -> let find f = fromJust . lookupFM f" , " dec_fn f = decode (find f) r" , " in GLR_Result (\\ff -> dec_fn $ ff f) (dec_fn f)" ] BNFC-2.6.0.3/src/formats/haskell2/CFtoAbstract.hs0000644000000000000000000000370712100475634017411 0ustar0000000000000000{- BNF Converter: Abstract syntax Generator Copyright (C) 2004 Author: Markus Forberg 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoAbstract (cf2Abstract) where import CF import Utils((+++),(++++)) import Data.List(intersperse) -- to produce a Haskell module cf2Abstract :: Bool -> String -> CF -> String cf2Abstract byteStrings name cf = unlines $ ("module "++name +++ "where\n") : "-- Haskell module generated by the BNF converter\n" : (if byteStrings then "import qualified Data.ByteString.Char8 as BS" else "") : (map (prSpecialData byteStrings cf) (specialCats cf) ++ map prData (cf2data cf)) prData :: Data -> String prData (cat,rules) = "data" +++ cat +++ "=\n " ++ concat (intersperse "\n | " (map prRule rules)) ++++ " deriving (Eq,Ord,Show)\n" where prRule (fun,cats) = unwords (fun:cats) prSpecialData :: Bool -> CF -> Cat -> String prSpecialData byteStrings cf cat = unwords ["newtype",cat,"=",cat,contentSpec byteStrings cf cat,"deriving (Eq,Ord,Show)"] contentSpec :: Bool -> CF -> Cat -> String contentSpec byteStrings cf cat = if isPositionCat cf cat then "((Int,Int),"++stringType++")" else stringType where stringType | byteStrings = "BS.ByteString" | otherwise = "String"BNFC-2.6.0.3/src/formats/haskell2/CFtoPrinter.hs0000644000000000000000000001522212100475634017264 0ustar0000000000000000{- BNF Converter: Pretty-printer generator Copyright (C) 2004 Author: Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoPrinter (cf2Printer) where import CF import Utils import CFtoTemplate import Data.List (intersperse) import Data.Char(toLower) -- derive pretty-printer from a BNF grammar. AR 15/2/2002 cf2Printer :: Bool -> String -> String -> CF -> String cf2Printer byteStrings name absMod cf = unlines [ prologue byteStrings name absMod, integerRule cf, doubleRule cf, if hasIdent cf then identRule byteStrings cf else "", unlines [ownPrintRule byteStrings cf own | (own,_) <- tokenPragmas cf], rules cf ] prologue :: Bool -> String -> String -> String prologue byteStrings name absMod = unlines [ "{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}", "module " ++ name +++ "where\n", "-- pretty-printer generated by the BNF converter\n", "import " ++ absMod, "import Data.Char", (if byteStrings then "import qualified Data.ByteString.Char8 as BS" else ""), "", "-- the top-level printing method", "printTree :: Print a => a -> String", "printTree = render . prt 0", "", "type Doc = [ShowS] -> [ShowS]", "", "doc :: ShowS -> Doc", "doc = (:)", "", "render :: Doc -> String", "render d = rend 0 (map ($ \"\") $ d []) \"\" where", " rend i ss = case ss of", " \"[\" :ts -> showChar '[' . rend i ts", " \"(\" :ts -> showChar '(' . rend i ts", " \"{\" :ts -> showChar '{' . new (i+1) . rend (i+1) ts", " \"}\" : \";\":ts -> new (i-1) . space \"}\" . showChar ';' . new (i-1) . rend (i-1) ts", " \"}\" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts", " \";\" :ts -> showChar ';' . new i . rend i ts", " t : \",\" :ts -> showString t . space \",\" . rend i ts", " t : \")\" :ts -> showString t . showChar ')' . rend i ts", " t : \"]\" :ts -> showString t . showChar ']' . rend i ts", " t :ts -> space t . rend i ts", " _ -> id", " new i = showChar '\\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace", " space t = showString t . (\\s -> if null s then \"\" else (' ':s))", "", "parenth :: Doc -> Doc", "parenth ss = doc (showChar '(') . ss . doc (showChar ')')", "", "concatS :: [ShowS] -> ShowS", "concatS = foldr (.) id", "", "concatD :: [Doc] -> Doc", "concatD = foldr (.) id", "", "replicateS :: Int -> ShowS -> ShowS", "replicateS n f = concatS (replicate n f)", "", "-- the printer class does the job", "class Print a where", " prt :: Int -> a -> Doc", " prtList :: [a] -> Doc", " prtList = concatD . map (prt 0)", "", "instance Print a => Print [a] where", " prt _ = prtList", "", "instance Print Char where", " prt _ s = doc (showChar '\\'' . mkEsc '\\'' s . showChar '\\'')", " prtList s = doc (showChar '\"' . concatS (map (mkEsc '\"') s) . showChar '\"')", "", "mkEsc :: Char -> Char -> ShowS", "mkEsc q s = case s of", " _ | s == q -> showChar '\\\\' . showChar s", " '\\\\'-> showString \"\\\\\\\\\"", " '\\n' -> showString \"\\\\n\"", " '\\t' -> showString \"\\\\t\"", " _ -> showChar s", "", "prPrec :: Int -> Int -> Doc -> Doc", "prPrec i j = if j String rules cf = unlines $ map (\(s,xs) -> case_fun s (map toArgs xs) ++ ifList cf s) $ cf2data cf where toArgs (cons,args) = ((cons, names (map (checkRes . var) args) (0 :: Int)), ruleOf cons) names [] _ = [] names (x:xs) n | elem x xs = (x ++ show n) : names xs (n+1) | otherwise = x : names xs n var ('[':xs) = var (init xs) ++ "s" var "Ident" = "id" var "Integer" = "n" var "String" = "str" var "Char" = "c" var "Double" = "d" var xs = map toLower xs checkRes s | elem s reservedHaskell = s ++ "'" | otherwise = s reservedHaskell = ["case","class","data","default","deriving","do","else","if", "import","in","infix","infixl","infixr","instance","let","module", "newtype","of","then","type","where","as","qualified","hiding"] ruleOf s = maybe undefined id $ lookupRule s (rulesOfCF cf) --- case_fun :: Cat -> [(Constructor,Rule)] -> String case_fun cat xs = unlines [ "instance Print" +++ cat +++ "where", " prt i" +++ "e = case e of", unlines $ map (\ ((c,xx),r) -> " " ++ c +++ unwords xx +++ "->" +++ "prPrec i" +++ show (precCat (fst r)) +++ mkRhs xx (snd r)) xs ] ifList cf cat = mkListRule $ nil cat ++ one cat ++ cons cat where nil cat = [" [] -> " ++ mkRhs [] its | Rule f c its <- rulesOfCF cf, isNilFun f , normCatOfList c == cat] one cat = [" [x] -> " ++ mkRhs ["x"] its | Rule f c its <- rulesOfCF cf, isOneFun f , normCatOfList c == cat] cons cat = [" x:xs -> " ++ mkRhs ["x","xs"] its | Rule f c its <- rulesOfCF cf, isConsFun f , normCatOfList c == cat] mkListRule [] = "" mkListRule rs = unlines $ (" prtList" +++ "es = case es of"):rs mkRhs args its = "(concatD [" ++ unwords (intersperse "," (mk args its)) ++ "])" where mk args (Left "#" : items) = mk args items mk (arg:args) (Left c : items) = (prt c +++ arg) : mk args items mk args (Right s : items) = ("doc (showString" +++ show s ++ ")") : mk args items mk _ _ = [] prt c = "prt" +++ show (precCat c) BNFC-2.6.0.3/src/formats/cpp_stl/0000755000000000000000000000000012100475635014467 5ustar0000000000000000BNFC-2.6.0.3/src/formats/cpp_stl/CFtoCVisitSkelSTL.hs0000644000000000000000000001027212100475635020204 0ustar0000000000000000{- BNF Converter: C++ Skeleton generation Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C++ Skeleton functions. The generated files use the Visitor design pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 9 August, 2003 Modified : 29 August, 2006 Aarne Ranta ************************************************************** -} module CFtoCVisitSkelSTL (cf2CVisitSkel) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper) import OOAbstract import STLUtils --Produces (.H file, .C file) cf2CVisitSkel :: Maybe String -> CF -> (String, String) cf2CVisitSkel inPackage cf = (mkHFile inPackage cab, mkCFile inPackage cab) where cab = cf2cabs cf -- **** Header (.H) File Functions **** --Generates the Header File mkHFile :: Maybe String -> CAbs -> String mkHFile inPackage cf = unlines [ "#ifndef " ++ hdef, "#define " ++ hdef, "/* You might want to change the above name. */", "", "#include \"Absyn.H\"", "", nsStart inPackage, "class Skeleton : public Visitor", "{", "public:", unlines [" void visit" ++ b ++ "(" ++ b ++ "* p);" | b <- classes, notElem b (defineds cf)], unlines [" void visit" ++ b ++ "(" ++ b ++ " x);" | b <- basics], "};", nsEnd inPackage, "", "#endif" ] where hdef = nsDefine inPackage "SKELETON_HEADER" classes = allClasses cf basics = tokentypes cf ++ map fst basetypes -- **** Implementation (.C) File Functions **** --Makes the .C File mkCFile :: Maybe String -> CAbs -> String mkCFile inPackage cf = unlines [ headerC, nsStart inPackage, unlines [ "void Skeleton::visit" ++ t ++ "(" ++ t ++ "* t) {} //abstract class" | t <- absclasses cf], unlines [prCon r | (_,rs) <- signatures cf, r <- rs], unlines [prList cb | cb <- listtypes cf], unlines [prBasic b | b <- tokentypes cf ++ map fst basetypes], nsEnd inPackage ] headerC = unlines [ "/*** BNFC-Generated Visitor Design Pattern Skeleton. ***/", "/* This implements the common visitor design pattern.", " Note that this method uses Visitor-traversal of lists, so", " List->accept() does NOT traverse the list. This allows different", " algorithms to use context information differently. */", "", "#include \"Skeleton.H\"", "" ] prBasic c = unlines [ "void Skeleton::visit" ++ c ++ "(" ++ c ++ " x)", "{", " /* Code for " ++ c ++ " Goes Here */", "}" ] prList (cl,b) = unlines [ "void Skeleton::visit" ++ cl ++ "("++ cl ++ "*" +++ vname ++ ")", "{", " for ("++ cl ++"::iterator i = " ++ vname++"->begin() ; i != " ++vname ++"->end() ; ++i)", " {", if b then " (*i)->accept(this);" else " visit" ++ drop 4 cl ++ "(*i) ;", " }", "}" ] where vname = map toLower cl prCon fcs@(f,cs) = unlines [ "void Skeleton::visit" ++ f ++ "(" ++ f ++ " *" ++ v ++ ")", "{", " /* Code For " ++ f ++ " Goes Here */", "", unlines [" " ++ visitArg c | c <- cs], "}" ] where v = map toLower f visitArg (cat,isPt,var) = if isPt then (v ++ "->" ++ var ++ "->accept(this);") else ("visit" ++ cat ++ "(" ++ v ++ "->" ++ var ++ ");") BNFC-2.6.0.3/src/formats/cpp_stl/STLUtils.hs0000644000000000000000000000250312100475635016506 0ustar0000000000000000{- BNF Converter: C++ common functions Copyright (C) 2008 Author: Martin Ejdestig 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module STLUtils where import Data.Char nsDefine :: Maybe String -> String -> String nsDefine inPackage h = maybe h (\ns -> map toUpper ns ++ "_" ++ h) inPackage nsStart :: Maybe String -> String nsStart inPackage = maybe "" (\ns -> "namespace " ++ ns ++ "\n{") inPackage nsEnd :: Maybe String -> String nsEnd inPackage = maybe "" (\ns -> "}") inPackage nsScope :: Maybe String -> String nsScope inPackage = maybe "" (\ns -> ns ++ "::") inPackage nsString :: Maybe String -> String nsString inPackage = maybe "" id inPackage BNFC-2.6.0.3/src/formats/cpp_stl/CFtoSTLAbs.hs0000644000000000000000000001660512100475635016677 0ustar0000000000000000{- BNF Converter: C++ abstract syntax generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the C++ Abstract Syntax tree classes. It generates both a Header file and an Implementation file, and uses the Visitor design pattern. It uses STL (Standard Template Library). Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 4 August, 2003 Modified : 22 May, 2004 / Antti-Juhani Kaijanaho 29 August, 2006 / Aarne Ranta ************************************************************** -} module CFtoSTLAbs (cf2CPPAbs) where import OOAbstract import CF import Utils((+++),(++++)) import NamedVariables import Data.List import Data.Char(toLower) import STLUtils --The result is two files (.H file, .C file) cf2CPPAbs :: Bool -> Maybe String -> String -> CF -> (String, String) cf2CPPAbs ln inPackage name cf = (mkHFile ln inPackage cab, mkCFile inPackage cab) where cab = cf2cabs cf -- **** Header (.H) File Functions **** -- --Makes the Header file. mkHFile :: Bool -> Maybe String -> CAbs -> String mkHFile ln inPackage cf = unlines [ "#ifndef " ++ hdef, "#define " ++ hdef, "", "#include", "#include", "", "//C++ Abstract Syntax Interface generated by the BNF Converter.", nsStart inPackage, "/******************** TypeDef Section ********************/", "", unlines ["typedef " ++ d ++ " " ++ c ++ ";" | (c,d) <- basetypes], "", unlines ["typedef std::string " ++ s ++ ";" | s <- tokentypes cf], "", "/******************** Forward Declarations ********************/", "", unlines ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cf)], "", "/******************** Visitor Interfaces ********************/", prVisitor cf, "", prVisitable, "", "/******************** Abstract Syntax Classes ********************/", "", unlines [prAbs ln c | c <- absclasses cf], "", unlines [prCon (c,r) | (c,rs) <- signatures cf, r <- rs], "", unlines [prList c | c <- listtypes cf], nsEnd inPackage, "#endif" ] where classes = allClasses cf hdef = nsDefine inPackage "ABSYN_HEADER" -- auxiliaries prVisitable :: String prVisitable = unlines [ "class Visitable", "{", " public:", -- all classes with virtual methods require a virtual destructor " virtual ~Visitable() {}", " virtual void accept(Visitor *v) = 0;", "};" ] prVisitor :: CAbs -> String prVisitor cf = unlines [ "class Visitor", "{", "public:", " virtual ~Visitor() {}", unlines [" virtual void visit"++c++"("++c++" *p) = 0;" | c <- allClasses cf, notElem c (defineds cf)], "", unlines [" virtual void visit"++c++"(" ++c++" x) = 0;" | c <- allNonClasses cf], "};" ] prAbs :: Bool -> Cat -> String prAbs ln c = unlines [ "class " ++c++ " : public Visitable", "{", "public:", " virtual " ++ c ++ " *clone() const = 0;", if ln then " int line_number;" else "", "};" ] prCon :: (Cat,CAbsRule) -> String prCon (c,(f,cs)) = unlines [ "class " ++f++ " : public " ++ c, "{", "public:", unlines [" "++ typ +++ pointerIf st var ++ ";" | (typ,st,var) <- cs], " " ++ f ++ "(const " ++ f ++ " &);", " " ++ f ++ " &operator=(const " ++f++ " &);", " " ++ f ++ "(" ++ conargs ++ ");", -- Typ *p1, PIdent *p2, ListStm *p3); " ~" ++f ++ "();", " virtual void accept(Visitor *v);", " virtual " ++f++ " *clone() const;", " void swap(" ++f++ " &);", "};" ] where conargs = concat $ intersperse ", " [x +++ pointerIf st ("p" ++ show i) | ((x,st,_),i) <- zip cs [1..]] prList :: (Cat,Bool) -> String prList (c,b) = unlines [ "class " ++c++ " : public Visitable, public std::vector<" ++bas++ ">", "{", "public:", " virtual void accept(Visitor *v);", " virtual " ++ c ++ " *clone() const;", "};" ] where bas = drop 4 c ++ -- drop List if b then "*" else "" -- **** Implementation (.C) File Functions **** -- mkCFile :: Maybe String -> CAbs -> String mkCFile inPackage cf = unlines $ [ "//C++ Abstract Syntax Implementation generated by the BNF Converter.", "#include ", "#include ", "#include ", "#include ", "#include \"Absyn.H\"", nsStart inPackage, unlines [prConC r | (_,rs) <- signatures cf, r <- rs], unlines [prListC c | (c,_) <- listtypes cf], nsEnd inPackage ] prConC :: CAbsRule -> String prConC fcs@(f,cs) = unlines [ "/******************** " ++ f ++ " ********************/", prConstructorC fcs, prCopyC fcs, prDestructorC fcs, prAcceptC f, prCloneC f, "" ] prListC :: Cat -> String prListC c = unlines [ "/******************** " ++ c ++ " ********************/", "", prAcceptC c, "", prCloneC c ] --The standard accept function for the Visitor pattern prAcceptC :: Cat -> String prAcceptC ty = unlines [ "void " ++ ty ++ "::accept(Visitor *v)", "{", " v->visit" ++ ty ++ "(this);", "}" ] --The cloner makes a new deep copy of the object prCloneC :: Cat -> String prCloneC c = unlines [ c +++ "*" ++ c ++ "::clone() const", "{", " return new" +++ c ++ "(*this);", "}" ] --The constructor assigns the parameters to the corresponding instance variables. prConstructorC :: CAbsRule -> String prConstructorC (f,cs) = unlines [ f ++ "::" ++ f ++ "(" ++ conargs ++ ")", "{", unlines [" " ++ c ++ " = " ++ p ++ ";" | (c,p) <- zip cvs pvs], "}" ] where cvs = [c | (_,_,c) <- cs] pvs = ["p" ++ show i | ((x,st,_),i) <- zip cs [1..]] conargs = concat $ intersperse ", " [x +++ pointerIf st v | ((x,st,_),v) <- zip cs pvs] --Copy constructor and copy assignment prCopyC :: CAbsRule -> String prCopyC (c,cs) = unlines [ c ++ "::" ++ c ++ "(const" +++ c +++ "& other)", "{", unlines [" " ++ cv ++ " = other." ++ cloneIf st cv ++ ";" | (_,st,cv) <- cs], "}", "", c +++ "&" ++ c ++ "::" ++ "operator=(const" +++ c +++ "& other)", "{", " " ++ c +++ "tmp(other);", " swap(tmp);", " return *this;", "}", "", "void" +++ c ++ "::swap(" ++ c +++ "& other)", "{", unlines [" std::swap(" ++ cv ++ ", other." ++ cv ++ ");" | (_,_,cv) <- cs], "}" ] where cloneIf st cv = if st then (cv ++ "->clone()") else cv --The destructor deletes all a class's members. prDestructorC :: CAbsRule -> String prDestructorC (c,cs) = unlines [ c ++ "::~" ++ c ++"()", "{", unlines [" delete(" ++ cv ++ ");" | (_,isPointer,cv) <- cs, isPointer], "}" ] BNFC-2.6.0.3/src/formats/cpp_stl/CFtoBisonSTL.hs0000644000000000000000000003060212100475635017235 0ustar0000000000000000{- BNF Converter: C++ Bison generator Copyright (C) 2004 Author: Michael Pellauer 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- ************************************************************** BNF Converter Module Description : This module generates the Bison input file using STL. The main difference to CFtoBison is in handling lists: by using std::vector and push_back, our rules for reverting lists are the opposite to linked lists. Note that because of the way bison stores results the programmer can increase performance by limiting the number of entry points in their grammar. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 6 August, 2003 Modified : 19 August, 2006, by Aarne Ranta (aarne@cs.chalmers.se) ************************************************************** -} module CFtoBisonSTL (cf2Bison) where import CF import Data.List (intersperse, isPrefixOf) import NamedVariables hiding (varName) import Data.Char (toLower,isUpper,isDigit) import Utils ((+++), (++++)) import TypeChecker import ErrM import STLUtils --This follows the basic structure of CFtoHappy. -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String --The environment comes from the CFtoFlex cf2Bison :: Bool -> Maybe String -> String -> CF -> SymEnv -> String cf2Bison ln inPackage name cf env = unlines [header inPackage name cf, union inPackage (positionCats cf ++ allCats cf), maybe "" (\ns -> "%name-prefix=\"" ++ ns ++ "yy\"") inPackage, "%token _ERROR_", tokens user env, declarations cf, specialToks cf, "%%", prRules (rulesForBison ln inPackage name cf env) ] where user = fst (unzip (tokenPragmas cf)) positionCats cf = filter (isPositionCat cf) $ fst (unzip (tokenPragmas cf)) header :: Maybe String -> String -> CF -> String header inPackage name cf = unlines ["/* This Bison file was machine-generated by BNFC */", "%{", "#include ", "#include ", "#include ", "#include ", "#include ", "#include \"Absyn.H\"", "typedef struct yy_buffer_state *YY_BUFFER_STATE;", "int yyparse(void);", "int yylex(void);", "YY_BUFFER_STATE " ++ ns ++ "yy_scan_string(const char *str);", "void " ++ ns ++ "yy_delete_buffer(YY_BUFFER_STATE buf);", "int " ++ ns ++ "yy_mylinenumber;", --- hack to get line number. AR 2006 "int " ++ ns ++ "initialize_lexer(FILE * inp);", "int " ++ ns ++ "yywrap(void)", "{", " return 1;", "}", "void " ++ ns ++ "yyerror(const char *str)", "{", " std::cout << \"line \" << " ++ ns ++ "yy_mylinenumber << std::endl ;", " fprintf(stderr,\"error: %s\\n\",str);", "}", "", definedRules cf, nsStart inPackage, unlines $ map (parseMethod inPackage name) (allCatsIdNorm cf ++ positionCats cf), -- (allEntryPoints cf), M.F. 2004-09-14 fix of [Ty2] bug. nsEnd inPackage, "%}" ] where ns = nsString inPackage definedRules :: CF -> String definedRules cf = unlines [ rule f xs e | FunDef f xs e <- pragmasOfCF cf ] where ctx = buildContext cf list = LC (const "[]") (\t -> "List" ++ unBase t) where unBase (ListT t) = unBase t unBase (BaseT x) = normCat x rule f xs e = case checkDefinition' list ctx f xs e of Bad err -> error $ "Panic! This should have been caught already:\n" ++ err Ok (args,(e',t)) -> unlines [ cppType t ++ " " ++ f ++ "_ (" ++ concat (intersperse ", " $ map cppArg args) ++ ") {" , " return " ++ cppExp e' ++ ";" , "}" ] where cppType :: Base -> String cppType (ListT (BaseT x)) = "List" ++ normCat x ++ " *" cppType (ListT t) = cppType t ++ " *" cppType (BaseT x) | isToken x ctx = "String" | otherwise = normCat x ++ " *" cppArg :: (String, Base) -> String cppArg (x,t) = cppType t ++ " " ++ x ++ "_" cppExp :: Exp -> String cppExp (App "[]" []) = "0" cppExp (App x []) | elem x xs = x ++ "_" -- argument cppExp (App t [e]) | isToken t ctx = cppExp e cppExp (App x es) | isUpper (head x) = call ("new " ++ x) es | otherwise = call (x ++ "_") es cppExp (LitInt n) = show n cppExp (LitDouble x) = show x cppExp (LitChar c) = show c cppExp (LitString s) = show s call x es = x ++ "(" ++ concat (intersperse ", " $ map cppExp es) ++ ")" --This generates a parser method for each entry point. parseMethod :: Maybe String -> String -> Cat -> String parseMethod inPackage name cat = -- if normCat cat /= cat M.F. 2004-09-17 comment. No duplicates from allCatsIdNorm -- then "" -- else unlines [ "static " ++ cat' ++ "*" +++ (resultName cat') +++ "= 0;", cat' ++"* p" ++ cat' ++ "(FILE *inp)", "{", " " ++ ns ++ "yy_mylinenumber = 1;", -- O.F. " " ++ ns ++ "initialize_lexer(inp);", " if (yyparse())", " { /* Failure */", " return 0;", " }", " else", " { /* Success */", " return" +++ (resultName cat') ++ ";", " }", "}", cat' ++"* p" ++ cat' ++ "(const char *str)", "{", " YY_BUFFER_STATE buf;", " int result;", " " ++ ns ++ "yy_mylinenumber = 1;", " " ++ ns ++ "initialize_lexer(0);", " buf = " ++ ns ++ "yy_scan_string(str);", " result = yyparse();", " " ++ ns ++ "yy_delete_buffer(buf);", " if (result)", " { /* Failure */", " return 0;", " }", " else", " { /* Success */", " return" +++ (resultName cat') ++ ";", " }", "}" ] where cat' = identCat (normCat cat) ns = nsString inPackage --The union declaration is special to Bison/Yacc and gives the type of yylval. --For efficiency, we may want to only include used categories here. union :: Maybe String -> [Cat] -> String union inPackage cats = unlines [ "%union", "{", " int int_;", " char char_;", " double double_;", " char* string_;", concatMap mkPointer cats, "}" ] where --This is a little weird because people can make [Exp2] etc. mkPointer s | identCat s /= s = --list. add it even if it refers to a coercion. " " ++ scope ++ (identCat (normCat s)) ++ "*" +++ (varName (normCat s)) ++ ";\n" mkPointer s | normCat s == s = --normal cat " " ++ scope ++ (identCat (normCat s)) ++ "*" +++ (varName (normCat s)) ++ ";\n" mkPointer s = "" scope = nsScope inPackage --declares non-terminal types. declarations :: CF -> String declarations cf = concatMap (typeNT cf) (positionCats cf ++ allCats cf) where --don't define internal rules typeNT cf nt | (isPositionCat cf nt || rulesForCat cf nt /= []) = "%type <" ++ (varName (normCat nt)) ++ "> " ++ (identCat nt) ++ "\n" typeNT cf nt = "" --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user ts = concatMap (declTok user) ts where declTok u (s,r) = if elem s u then "%token " ++ r ++ " // " ++ s ++ "\n" else "%token " ++ r ++ " // " ++ s ++ "\n" specialToks :: CF -> String specialToks cf = concat [ ifC "String" "%token _STRING_\n", ifC "Char" "%token _CHAR_\n", ifC "Integer" "%token _INTEGER_\n", ifC "Double" "%token _DOUBLE_\n", ifC "Ident" "%token _IDENT_\n" ] where ifC cat s = if isUsedCat cf cat then s else "" --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForBison :: Bool -> Maybe String -> String -> CF -> SymEnv -> Rules rulesForBison ln inPackage name cf env = (map mkOne $ ruleGroups cf) ++ posRules where mkOne (cat,rules) = constructRule ln inPackage cf env rules cat posRules = map mkPos $ positionCats cf mkPos cat = (cat, [(maybe cat id (lookup cat env), "$$ = new " ++ cat ++ "($1," ++ nsString inPackage ++ "yy_mylinenumber) ; YY_RESULT_" ++ cat ++ "_= $$ ;")]) -- For every non-terminal, we construct a set of rules. constructRule :: Bool -> Maybe String -> CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule ln inPackage cf env rules nt = (nt,[(p,(generateAction ln inPackage nt (ruleName r) b m) +++ result) | r0 <- rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True,revSepListRule r0) else (False,r0), let (p,m) = generatePatterns cf env r b]) where ruleName r = case funRule r of ---- "(:)" -> identCat nt ---- "(:[])" -> identCat nt z -> z revs = reversibleCats cf eps = allEntryPoints cf isEntry nt = if elem nt eps then True else False result = if isEntry nt then (nsScope inPackage ++ resultName (normCat (identCat nt))) ++ "= $$;" else "" -- Generates a string containing the semantic action. generateAction :: Bool -> Maybe String -> NonTerminal -> Fun -> Bool -> [(MetaVar,Bool)] -> Action generateAction ln inPackage cat f b mbs = reverses ++ if isCoercion f then "$$ = " ++ (unwords ms) ++ ";" else if (f == "[]") then concat ["$$ = ","new ", scope, identCatV cat, "();"] else if (f == "(:[])") then concat ["$$ = ","new ", scope, identCatV cat, "() ; $$->push_back($1);"] else if (f == "(:)" && b) then "$1->push_back("++ lastms ++ ") ; $$ = $1 ;" else if (f == "(:)") then lastms ++ "->push_back($1) ; $$ = " ++ lastms ++ " ;" ---- not left rec else if isDefinedRule f then concat ["$$ = ", scope, f, "_", "(", concat $ intersperse ", " ms', ");" ] else concat ["$$ = ", "new ", scope, f, "(", (concat (intersperse ", " ms')), ");" ++ addLn ln] where ms = map fst mbs ms' = ms addLn ln = if ln then " $$->line_number = " ++ nsString inPackage ++ "yy_mylinenumber;" else "" -- O.F. lastms = last ms identCatV cat = reverse $ dropWhile isDigit $ reverse $ identCat cat reverses = unwords [ "std::reverse(" ++ m ++"->begin(),"++m++"->end()) ;" | (m,True) <- mbs] scope = nsScope inPackage -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: CF -> SymEnv -> Rule -> Bool -> (Pattern,[(MetaVar,Bool)]) generatePatterns cf env r revv = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> case lookup c env of Just x | not (isPositionCat cf c) -> x _ -> typeName (identCat c) Right s -> case lookup s env of Just x -> x Nothing -> s metas its = [('$': show i,revert c) | (i,Left c) <- zip [1 :: Int ..] its] -- notice: reversibility with push_back vectors is the opposite -- of right-recursive lists! revert c = (head c == '[') && not (isConsFun (funRule r)) && notElem c revs revs = reversibleCats cf -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. prRules :: Rules -> String prRules [] = [] prRules ((nt, []):rs) = prRules rs --internal rule prRules ((nt,((p,a):ls)):rs) = (unwords [nt', ":" , p, "{ ", a, "}", "\n" ++ pr ls]) ++ ";\n" ++ prRules rs where nt' = identCat nt pr [] = [] pr ((p,a):ls) = (unlines [(concat $ intersperse " " [" |", p, "{ ", a , "}"])]) ++ pr ls --Some helper functions. resultName :: String -> String resultName s = "YY_RESULT_" ++ s ++ "_" --slightly stronger than the NamedVariable version. varName :: String -> String varName s = (map toLower (identCat s)) ++ "_" typeName :: String -> String typeName "Ident" = "_IDENT_" typeName "String" = "_STRING_" typeName "Char" = "_CHAR_" typeName "Integer" = "_INTEGER_" typeName "Double" = "_DOUBLE_" typeName x = x BNFC-2.6.0.3/src/formats/cpp_stl/CFtoSTLPrinter.hs0000644000000000000000000004405712100475635017617 0ustar0000000000000000{- ************************************************************** BNF Converter Module Description : This module generates the C++ Pretty Printer. It also generates the "show" method for printing an abstract syntax tree. The generated files use the Visitor design pattern. Author : Michael Pellauer (pellauer@cs.chalmers.se) License : GPL (GNU General Public License) Created : 10 August, 2003 Modified : 3 September, 2003 * Added resizable buffers ************************************************************** -} module CFtoSTLPrinter (cf2CPPPrinter) where import CF import Utils ((+++), (++++)) import NamedVariables import Data.List import Data.Char(toLower, toUpper) import STLUtils --Produces (.H file, .C file) cf2CPPPrinter :: Maybe String -> CF -> (String, String) cf2CPPPrinter inPackage cf = (mkHFile inPackage cf groups, mkCFile inPackage cf groups) where groups = positionRules cf ++ (fixCoercions (ruleGroupsInternals cf)) positionRules :: CF -> [(Cat,[Rule])] positionRules cf = [(cat,[Rule cat cat [Left "String", Left "Integer"]]) | cat <- filter (isPositionCat cf) $ fst (unzip (tokenPragmas cf))] {- **** Header (.H) File Methods **** -} --An extremely large function to make the Header File mkHFile :: Maybe String -> CF -> [(Cat,[Rule])] -> String mkHFile inPackage cf groups = unlines [ printHeader, concatMap prDataH groups, classFooter, showHeader, concatMap prDataH groups, classFooter, footer ] where printHeader = unlines [ "#ifndef " ++ hdef, "#define " ++ hdef, "", "#include \"Absyn.H\"", "#include ", "#include ", "#include ", "", nsStart inPackage, "/* Certain applications may improve performance by changing the buffer size */", "#define " ++ nsDefine inPackage "BUFFER_INITIAL" ++ " 2000", "/* You may wish to change _L_PAREN or _R_PAREN */", "#define " ++ nsDefine inPackage "_L_PAREN" ++ " '('", "#define " ++ nsDefine inPackage "_R_PAREN" ++ " ')'", "", "class PrintAbsyn : public Visitor", "{", " protected:", " int _n_, _i_;", " /* The following are simple heuristics for rendering terminals */", " /* You may wish to change them */", " void render(Char c);", " void render(String s);", " void indent(void);", " void backup(void);", " public:", " PrintAbsyn(void);", " ~PrintAbsyn(void);", " char* print(Visitable* v);" ] hdef = nsDefine inPackage "PRINTER_HEADER" classFooter = unlines $ [ " void visitInteger(Integer i);", " void visitDouble(Double d);", " void visitChar(Char c);", " void visitString(String s);", " void visitIdent(String s);" ] ++ [" void visit" ++ t ++ "(String s);" | t <- tokenNames cf] ++ [ " protected:", " void inline bufAppend(const char* s)", " {", " int len = strlen(s);", " while (cur_ + len > buf_size)", " {", " buf_size *= 2; /* Double the buffer size */", " resizeBuffer();", " }", " for(int n = 0; n < len; n++)", " {", " buf_[cur_ + n] = s[n];", " }", " cur_ += len;", " buf_[cur_] = 0;", " }", " void inline bufAppend(const char c)", " {", " if (cur_ == buf_size)", " {", " buf_size *= 2; /* Double the buffer size */", " resizeBuffer();", " }", " buf_[cur_] = c;", " cur_++;", " buf_[cur_] = 0;", " }", " void inline bufReset(void)", " {", " cur_ = 0;", " buf_size = " ++ nsDefine inPackage "BUFFER_INITIAL" ++ ";", " resizeBuffer();", " memset(buf_, 0, buf_size);", " }", " void inline resizeBuffer(void)", " {", " char* temp = (char*) malloc(buf_size);", " if (!temp)", " {", " fprintf(stderr, \"Error: Out of memory while attempting to grow buffer!\\n\");", " exit(1);", " }", " if (buf_)", " {", " strcpy(temp, buf_);", " free(buf_);", " }", " buf_ = temp;", " }", " char *buf_;", " int cur_, buf_size;", "};", "" ] showHeader = unlines [ "", "class ShowAbsyn : public Visitor", "{", " public:", " ShowAbsyn(void);", " ~ShowAbsyn(void);", " char* show(Visitable* v);" ] footer = unlines [ nsEnd inPackage, "", "#endif" ] --Prints all the required method names and their parameters. prDataH :: (Cat, [Rule]) -> String prDataH (cat, rules) = if "List" `isPrefixOf` (identCat cat) then concat [" void visit", cl, "(", cl, "* p);\n"] else abstract ++ (concatMap prRuleH rules) where cl = identCat (normCat cat) abstract = case lookupRule cat rules of Just x -> "" Nothing -> " void visit" ++ cl ++ "(" ++ cl ++ " *p); /* abstract class */\n" --Prints all the methods to visit a rule. prRuleH :: Rule -> String prRuleH (Rule fun c cats) | isProperLabel fun = concat [" void visit", fun, "(", fun, " *p);\n"] prRuleH _ = "" {- **** Implementation (.C) File Methods **** -} --This makes the .C file by a similar method. mkCFile :: Maybe String -> CF -> [(Cat,[Rule])] -> String mkCFile inPackage cf groups = concat [ header, nsStart inPackage ++ "\n", prRender, printEntries, concatMap (prPrintData inPackage cf user) groups, printBasics, printTokens, showEntries, concatMap (prShowData user) groups, showBasics, showTokens, nsEnd inPackage ++ "\n" ] where user0 = fst (unzip (tokenPragmas cf)) (userPos,user) = partition (isPositionCat cf) user0 header = unlines [ "/*** BNFC-Generated Pretty Printer and Abstract Syntax Viewer ***/", "", "#include ", "#include \"Printer.H\"", "" ] printEntries = unlines [ "PrintAbsyn::PrintAbsyn(void)", "{", " _i_ = 0; _n_ = 0;", " buf_ = 0;", " bufReset();", "}", "", "PrintAbsyn::~PrintAbsyn(void)", "{", "}", "", "char* PrintAbsyn::print(Visitable *v)", "{", " _i_ = 0; _n_ = 0;", " bufReset();", " v->accept(this);", " return buf_;", "}" ] showEntries = unlines [ "ShowAbsyn::ShowAbsyn(void)", "{", " buf_ = 0;", " bufReset();", "}", "", "ShowAbsyn::~ShowAbsyn(void)", "{", "}", "", "char* ShowAbsyn::show(Visitable *v)", "{", " bufReset();", " v->accept(this);", " return buf_;", "}" ] printBasics = unlines [ "void PrintAbsyn::visitInteger(Integer i)", "{", " char tmp[16];", " sprintf(tmp, \"%d\", i);", " bufAppend(tmp);", "}", "void PrintAbsyn::visitDouble(Double d)", "{", " char tmp[16];", " sprintf(tmp, \"%g\", d);", " bufAppend(tmp);", "}", "void PrintAbsyn::visitChar(Char c)", "{", " bufAppend('\\'');", " bufAppend(c);", " bufAppend('\\'');", "}", "void PrintAbsyn::visitString(String s_)", "{", " const char *s = s_.c_str() ;", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "void PrintAbsyn::visitIdent(String s_)", "{", " const char *s = s_.c_str() ;", " render(s);", "}", "" ] printTokens = unlines [unlines [ "void PrintAbsyn::visit" ++ t ++ "(String s_)", "{", " const char *s = s_.c_str() ;", " render(s);", "}", "" ] | t <- tokenNames cf ] showBasics = unlines [ "void ShowAbsyn::visitInteger(Integer i)", "{", " char tmp[16];", " sprintf(tmp, \"%d\", i);", " bufAppend(tmp);", "}", "void ShowAbsyn::visitDouble(Double d)", "{", " char tmp[16];", " sprintf(tmp, \"%g\", d);", " bufAppend(tmp);", "}", "void ShowAbsyn::visitChar(Char c)", "{", " bufAppend('\\'');", " bufAppend(c);", " bufAppend('\\'');", "}", "void ShowAbsyn::visitString(String s_)", "{", " const char *s = s_.c_str() ;", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "void ShowAbsyn::visitIdent(String s_)", "{", " const char *s = s_.c_str() ;", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "" ] showTokens = unlines [unlines [ "void ShowAbsyn::visit" ++ t ++ "(String s_)", "{", " const char *s = s_.c_str() ;", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "" ] | t <- tokenNames cf ] {- **** Pretty Printer Methods **** -} --Generates methods for the Pretty Printer prPrintData :: Maybe String -> CF -> [UserDef] -> (Cat, [Rule]) -> String prPrintData inPackage cf user (cat, rules) = if "List" `isPrefixOf` (identCat cat) then unlines [ "void PrintAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")", "{", " for ("++ cl ++"::const_iterator i = " ++ vname++"->begin() ; i != " ++vname ++"->end() ; ++i)", " {", if isBase user vname then " visit" ++ baseName cl ++ "(*i) ;" else " (*i)->accept(this);", optsep, " }", "}", "" ] --Not a list: -- a position token else if isPositionCat cf cat then unlines [ "void PrintAbsyn::visit" ++ cat ++ "(" ++ cat ++ "* p)", "{", " visitIdent(p->string_);", "}" ] else abstract ++ (concatMap (prPrintRule inPackage user) rules) where cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl ++ "_" visitMember = if isBasic user member then " visit" ++ (funName member) ++ "(" ++ vname ++ "->" ++ member ++ ");" else " " ++ vname ++ "->" ++ member ++ "->accept(this);" sep = if (length sep') == 1 then "'" ++ (escapeChars sep') ++ "'" else "\"" ++ (escapeChars sep') ++ "\"" sep' = getCons rules optsep = (if hasOneFunc rules then " if (i != " ++ vname ++ "->end() - 1) " else " " ) ++ "render(" ++ sep ++ ");" abstract = case lookupRule cat rules of Just x -> "" Nothing -> "void PrintAbsyn::visit" ++ cl ++ "(" ++ cl ++ "*p) {} //abstract class\n\n" --Pretty Printer methods for a rule. prPrintRule :: Maybe String -> [UserDef] -> Rule -> String prPrintRule inPackage user r@(Rule fun c cats) | isProperLabel fun = unlines [ "void PrintAbsyn::visit" ++ fun ++ "(" ++ fun ++ "*" +++ fnm ++ ")", "{", " int oldi = _i_;", lparen, cats', rparen, " _i_ = oldi;", "}\n" ] where p = precRule r (lparen, rparen) = (" if (oldi > " ++ (show p) ++ ") render(" ++ nsDefine inPackage "_L_PAREN" ++ ");\n", " if (oldi > " ++ (show p) ++ ") render(" ++ nsDefine inPackage "_R_PAREN" ++ ");\n") cats' = (concatMap (prPrintCat user fnm) (zip (fixOnes (numVars [] cats)) (map getPrec cats))) fnm = "p" --old names could cause conflicts getPrec (Right s) = 0 getPrec (Left c) = precCat c prPrintRule _ _ _ = "" --This goes on to recurse to the instance variables. prPrintCat :: [UserDef] -> String -> (Either Cat String, Int) -> String prPrintCat user fnm (c,p) = case c of (Right t) -> " render(" ++ t' ++ ");\n" where t' = if length t == 1 then "'" ++ (escapeChars t) ++ "'" else "\"" ++ (escapeChars t) ++ "\"" (Left nt) -> if isBasic user nt then " visit" ++ (funName nt) ++ "(" ++ fnm ++ "->" ++ nt ++ ");\n" else if "list" `isPrefixOf` nt then " if(" ++ fnm ++ "->" ++ nt ++ ") {" ++ accept ++ "}" else " " ++ accept ++ "\n" where accept = if nt == "#_" --Internal category then "/* Internal Category */\n" else (setI p) ++ fnm ++ "->" ++ nt ++ "->accept(this);" {- **** Abstract Syntax Tree Printer **** -} --This prints the functions for Abstract Syntax tree printing. prShowData :: [UserDef] -> (Cat, [Rule]) -> String prShowData user (cat, rules) = if "List" `isPrefixOf` (identCat cat) then unlines [ "void ShowAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")", "{", " for ("++ cl ++"::const_iterator i = " ++ vname++"->begin() ; i != " ++vname ++"->end() ; ++i)", " {", if isBase user vname then " visit" ++ baseName cl ++ "(*i) ;" else " (*i)->accept(this);", " if (i != " ++ vname ++ "->end() - 1) bufAppend(\", \");", " }", "}", "" ] --Not a list: else abstract ++ (concatMap (prShowRule user) rules) where cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl ++ "_" visitMember = if isBasic user member then " visit" ++ (funName member) ++ "(" ++ vname ++ "->" ++ member ++ ");" else " " ++ vname ++ "->" ++ member ++ "->accept(this);" abstract = case lookupRule cat rules of Just x -> "" Nothing -> "void ShowAbsyn::visit" ++ cl ++ "(" ++ cl ++ "* p) {} //abstract class\n\n" --This prints all the methods for Abstract Syntax tree rules. prShowRule :: [UserDef] -> Rule -> String prShowRule user (Rule fun c cats) | isProperLabel fun = concat [ "void ShowAbsyn::visit" ++ fun ++ "(" ++ fun ++ "*" +++ fnm ++ ")\n", "{\n", lparen, " bufAppend(\"" ++ fun ++ "\");\n", optspace, cats', rparen, "}\n" ] where (optspace, lparen, rparen) = if allTerms cats then ("","","") else (" bufAppend(' ');\n", " bufAppend('(');\n"," bufAppend(')');\n") cats' = if allTerms cats then "" else concat (insertSpaces (map (prShowCat user fnm) (fixOnes (numVars [] cats)))) insertSpaces [] = [] insertSpaces (x:[]) = [x] insertSpaces (x:xs) = if x == "" then insertSpaces xs else (x : [" bufAppend(' ');\n"]) ++ (insertSpaces xs) allTerms [] = True allTerms ((Left z):zs) = False allTerms (z:zs) = allTerms zs fnm = "p" --other names could cause conflicts prShowRule _ _ = "" --This recurses to the instance variables of a class. prShowCat :: [UserDef] -> String -> Either Cat String -> String prShowCat user fnm c = case c of (Right t) -> "" (Left nt) -> if isBasic user nt then " visit" ++ (funName nt) ++ "(" ++ fnm ++ "->" ++ nt ++ ");\n" else if nt == "#_" --internal category then "/* Internal Category */\n" else if ((normCat nt) /= nt) then accept else concat [ " bufAppend('[');\n", " if (" ++ fnm ++ "->" ++ nt ++ ")" ++ accept, " bufAppend(']');\n" ] where accept = " " ++ fnm ++ "->" ++ nt ++ "->accept(this);\n" {- **** Helper Functions Section **** -} --Just checks if something is a basic or user-defined type. --This is because you don't -> a basic non-pointer type. isBasic :: [UserDef] -> String -> Bool isBasic user v = if elem (init v) user' then True else if "integer_" `isPrefixOf` v then True else if "char_" `isPrefixOf` v then True else if "string_" `isPrefixOf` v then True else if "double_" `isPrefixOf` v then True else if "ident_" `isPrefixOf` v then True else False where user' = map (map toLower) user -- from listident to ident_ isBase user vn = isBasic user (baseName vn ++ "_") -- from ListIdent to Ident baseName cl = drop 4 cl --The visit-function name of a basic type funName :: String -> String funName v = if "integer_" `isPrefixOf` v then "Integer" else if "char_" `isPrefixOf` v then "Char" else if "string_" `isPrefixOf` v then "String" else if "double_" `isPrefixOf` v then "Double" else if "ident_" `isPrefixOf` v then "Ident" else "Ident" --User-defined type --Just sets the coercion level for parentheses in the Pretty Printer. setI :: Int -> String setI n = "_i_ = " ++ (show n) ++ "; " --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) escapeChars (x:xs) = x : (escapeChars xs) --An extremely simple renderer for terminals. prRender :: String prRender = unlines [ "//You may wish to change render", "void PrintAbsyn::render(Char c)", "{", " if (c == '{')", " {", " bufAppend('\\n');", " indent();", " bufAppend(c);", " _n_ = _n_ + 2;", " bufAppend('\\n');", " indent();", " }", " else if (c == '(' || c == '[')", " bufAppend(c);", " else if (c == ')' || c == ']')", " {", " backup();", " bufAppend(c);", " bufAppend(' ');", " }", " else if (c == '}')", " {", " _n_ = _n_ - 2;", " backup();", " backup();", " bufAppend(c);", " bufAppend('\\n\');", " indent();", " }", " else if (c == ',')", " {", " backup();", " bufAppend(c);", " bufAppend(' ');", " }", " else if (c == ';')", " {", " backup();", " bufAppend(c);", " bufAppend('\\n');", " indent();", " }", " else if (c == 0) return;", " else", " {", " bufAppend(c);", " bufAppend(' ');", " }", "}", "void PrintAbsyn::render(String s_)", "{", " const char *s = s_.c_str() ;", " if(strlen(s) > 0)", " {", " bufAppend(s);", " bufAppend(' ');", " }", "}", "void PrintAbsyn::indent()", "{", " int n = _n_;", " while (n > 0)", " {", " bufAppend(' ');", " n--;", " }", "}", "void PrintAbsyn::backup()", "{", " if (buf_[cur_ - 1] == ' ')", " {", " buf_[cur_ - 1] = 0;", " cur_--;", " }", "}" ] BNFC-2.6.0.3/src/formats/cpp_stl/STLTop.hs0000644000000000000000000001707712100475635016164 0ustar0000000000000000{- BNF Converter: C++ Main file Copyright (C) 2004 Author: Markus Forsberg, Michael Pellauer Modified from CPPTop to STLTop 2006 by Aarne Ranta. 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module STLTop (makeSTL) where import Utils import CF import CFtoSTLAbs import CFtoFlex import CFtoBisonSTL import CFtoCVisitSkelSTL import CFtoSTLPrinter import CFtoLatex import System.Exit (exitFailure) import Data.Char import STLUtils makeSTL :: Bool -> Bool -> Maybe String -> String -> CF -> IO () makeSTL make linenumbers inPackage name cf = do let (hfile, cfile) = cf2CPPAbs linenumbers inPackage name cf writeFileRep "Absyn.H" hfile writeFileRep "Absyn.C" cfile let (flex, env) = cf2flex inPackage name cf writeFileRep (name ++ ".l") flex putStrLn " (Tested with flex 2.5.31)" let bison = cf2Bison linenumbers inPackage name cf env writeFileRep (name ++ ".y") bison putStrLn " (Tested with bison 1.875a)" let header = mkHeaderFile inPackage cf (allCats cf) (allEntryPoints cf) env writeFileRep "Parser.H" header let (skelH, skelC) = cf2CVisitSkel inPackage cf writeFileRep "Skeleton.H" skelH writeFileRep "Skeleton.C" skelC let (prinH, prinC) = cf2CPPPrinter inPackage cf writeFileRep "Printer.H" prinH writeFileRep "Printer.C" prinC writeFileRep "Test.C" (cpptest inPackage cf) let latex = cfToLatex name cf writeFileRep (name ++ ".tex") latex if make then (writeFileRep "Makefile" $ makefile name) else return () makefile :: String -> String makefile name = unlines [ "CC = g++", "CCFLAGS = -g", "FLEX = flex", "BISON = bison", "LATEX = latex", "DVIPS = dvips", "", "all: Test" ++ name ++ " " ++ name ++ ".ps", "", "clean:", -- peteg: don't nuke what we generated - move that to the "vclean" target. "\trm -f *.o " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps Test" ++ name, "", "distclean:", "\t rm -f *.o Absyn.C Absyn.H Test.C Parser.C Parser.H Lexer.C Skeleton.C Skeleton.H Printer.C Printer.H " ++ name ++ ".l " ++ name ++ ".y " ++ name ++ ".tex " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps Test" ++ name ++ " Makefile", "", "Test" ++ name ++ ": Absyn.o Lexer.o Parser.o Printer.o Test.o", "\t@echo \"Linking Test" ++ name ++ "...\"", "\t${CC} ${CCFLAGS} *.o -o Test" ++ name ++ "", " ", "Absyn.o: Absyn.C Absyn.H", "\t${CC} ${CCFLAGS} -c Absyn.C", "", "Lexer.C: " ++ name ++ ".l", "\t${FLEX} -oLexer.C " ++ name ++ ".l", "", "Parser.C: " ++ name ++ ".y", "\t${BISON} " ++ name ++ ".y -o Parser.C", "", "Lexer.o: Lexer.C Parser.H", "\t${CC} ${CCFLAGS} -c Lexer.C ", "", "Parser.o: Parser.C Absyn.H", "\t${CC} ${CCFLAGS} -c Parser.C", "", "Printer.o: Printer.C Printer.H Absyn.H", "\t${CC} ${CCFLAGS} -c Printer.C", "", "Skeleton.o: Skeleton.C Skeleton.H Absyn.H", "\t${CC} ${CCFLAGS} -c Skeleton.C", "", "Test.o: Test.C Parser.H Printer.H Absyn.H", "\t${CC} ${CCFLAGS} -c Test.C", "", "" ++ name ++ ".dvi: " ++ name ++ ".tex", "\t${LATEX} " ++ name ++ ".tex", "", "" ++ name ++ ".ps: " ++ name ++ ".dvi", "\t${DVIPS} " ++ name ++ ".dvi -o " ++ name ++ ".ps", "" ] cpptest :: Maybe String -> CF -> String cpptest inPackage cf = unlines [ "/*** Compiler Front-End Test automatically generated by the BNF Converter ***/", "/* */", "/* This test will parse a file, print the abstract syntax tree, and then */", "/* pretty-print the result. */", "/* */", "/****************************************************************************/", "#include ", "#include \"Parser.H\"", "#include \"Printer.H\"", "#include \"Absyn.H\"", "", "int main(int argc, char ** argv)", "{", " FILE *input;", " if (argc > 1) ", " {", " input = fopen(argv[1], \"r\");", " if (!input)", " {", " fprintf(stderr, \"Error opening input file.\\n\");", " exit(1);", " }", " }", " else input = stdin;", " /* The default entry point is used. For other options see Parser.H */", " " ++ scope ++ def ++ " *parse_tree = " ++ scope ++ "p" ++ def ++ "(input);", " if (parse_tree)", " {", " printf(\"\\nParse Succesful!\\n\");", " printf(\"\\n[Abstract Syntax]\\n\");", " " ++ scope ++ "ShowAbsyn *s = new " ++ scope ++ "ShowAbsyn();", " printf(\"%s\\n\\n\", s->show(parse_tree));", " printf(\"[Linearized Tree]\\n\");", " " ++ scope ++ "PrintAbsyn *p = new " ++ scope ++ "PrintAbsyn();", " printf(\"%s\\n\\n\", p->print(parse_tree));", " return 0;", " }", " return 1;", "}", "" ] where def = head (allEntryPoints cf) scope = nsScope inPackage mkHeaderFile inPackage cf cats eps env = unlines [ "#ifndef " ++ hdef, "#define " ++ hdef, "", "#include", "#include", "", nsStart inPackage, concatMap mkForwardDec cats, "typedef union", "{", " int int_;", " char char_;", " double double_;", " char* string_;", (concatMap mkVar cats) ++ "} YYSTYPE;", "", concatMap mkFuncs eps, nsEnd inPackage, "", "#define " ++ nsDefine inPackage "_ERROR_" ++ " 258", mkDefines (259 :: Int) env, "extern " ++ nsScope inPackage ++ "YYSTYPE " ++ nsString inPackage ++ "yylval;", "", "#endif" ] where hdef = nsDefine inPackage "PARSER_HEADER_FILE" mkForwardDec s | (normCat s == s) = "class " ++ (identCat s) ++ ";\n" mkForwardDec _ = "" mkVar s | (normCat s == s) = " " ++ (identCat s) ++"*" +++ (map toLower (identCat s)) ++ "_;\n" mkVar _ = "" mkDefines n [] = mkString n mkDefines n ((_,s):ss) = ("#define " ++ s +++ (show n) ++ "\n") ++ (mkDefines (n+1) ss) -- "nsDefine inPackage s" not needed (see cf2flex::makeSymEnv) mkString n = if isUsedCat cf "String" then ("#define " ++ nsDefine inPackage "_STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) else mkChar n mkChar n = if isUsedCat cf "Char" then ("#define " ++ nsDefine inPackage "_CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) else mkInteger n mkInteger n = if isUsedCat cf "Integer" then ("#define " ++ nsDefine inPackage "_INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) else mkDouble n mkDouble n = if isUsedCat cf "Double" then ("#define " ++ nsDefine inPackage "_DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) else mkIdent n mkIdent n = if isUsedCat cf "Ident" then ("#define " ++ nsDefine inPackage "_IDENT_ " ++ show n ++ "\n") else "" mkFuncs s | (normCat s == s) = (identCat s) ++ "*" +++ "p" ++ (identCat s) ++ "(FILE *inp);\n" ++ (identCat s) ++ "*" +++ "p" ++ (identCat s) ++ "(const char *str);\n" mkFuncs _ = "" BNFC-2.6.0.3/src/formats/haskell-gadt/0000755000000000000000000000000012100475635015363 5ustar0000000000000000BNFC-2.6.0.3/src/formats/haskell-gadt/CFtoPrinterGADT.hs0000644000000000000000000001344412100475635020564 0ustar0000000000000000{- BNF Converter: GADT Pretty-printer generator Copyright (C) 2004-2005 Author: Aarne Ranta, Björn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoPrinterGADT (cf2Printer) where import CF import Utils import CFtoTemplate import Data.List (intersperse) import Data.Char(toLower) import HaskellGADTCommon -- derive pretty-printer from a BNF grammar. AR 15/2/2002 cf2Printer :: String -> String -> CF -> String cf2Printer name absMod cf = unlines $ [ prologue name absMod, integerRule cf, doubleRule cf] ++ prPrt cf ++ [""] ++ concatMap (prPrtList cf) (filter isList (allCats cf)) prologue :: String -> String -> String prologue name absMod = unlines [ "{-# OPTIONS_GHC -fglasgow-exts #-}", "module " ++ name +++ "where\n", "-- pretty-printer generated by the BNF converter\n", "import " ++ absMod, "import Data.Char", "import Data.List (intersperse)", "", "-- the top-level printing method", "printTree :: Print a => a -> String", "printTree = render . prt 0", "", "type Doc = [ShowS] -> [ShowS]", "", "doc :: ShowS -> Doc", "doc = (:)", "", "render :: Doc -> String", "render d = rend 0 (map ($ \"\") $ d []) \"\" where", " rend i ss = case ss of", " \"[\" :ts -> showChar '[' . rend i ts", " \"(\" :ts -> showChar '(' . rend i ts", " \"{\" :ts -> showChar '{' . new (i+1) . rend (i+1) ts", " \"}\" : \";\":ts -> new (i-1) . space \"}\" . showChar ';' . new (i-1) . rend (i-1) ts", " \"}\" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts", " \";\" :ts -> showChar ';' . new i . rend i ts", " t : \",\" :ts -> showString t . space \",\" . rend i ts", " t : \")\" :ts -> showString t . showChar ')' . rend i ts", " t : \"]\" :ts -> showString t . showChar ']' . rend i ts", " t :ts -> space t . rend i ts", " _ -> id", " new i = showChar '\\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace", " space t = showString t . (\\s -> if null s then \"\" else (' ':s))", "", "parenth :: Doc -> Doc", "parenth ss = doc (showChar '(') . ss . doc (showChar ')')", "", "concatS :: [ShowS] -> ShowS", "concatS = foldr (.) id", "", "concatD :: [Doc] -> Doc", "concatD = foldr (.) id", "", "unwordsD :: [Doc] -> Doc", "unwordsD = concatD . intersperse (doc (showChar ' '))", "", "replicateS :: Int -> ShowS -> ShowS", "replicateS n f = concatS (replicate n f)", "", "-- the printer class does the job", "class Print a where", " prt :: Int -> a -> Doc", "", "instance Print Char where", " prt _ s = doc (showChar '\\'' . mkEsc '\\'' s . showChar '\\'')", "", "instance Print String where", " prt _ s = doc (showChar '\"' . concatS (map (mkEsc '\"') s) . showChar '\"')", "", "mkEsc :: Char -> Char -> ShowS", "mkEsc q s = case s of", " _ | s == q -> showChar '\\\\' . showChar s", " '\\\\'-> showString \"\\\\\\\\\"", " '\\n' -> showString \"\\\\n\"", " '\\t' -> showString \"\\\\t\"", " _ -> showChar s", "", "prPrec :: Int -> Int -> Doc -> Doc", "prPrec i j = if j Cat -> [String] ifList cf cat = prPrtList cf ("["++cat++"]") -- FIXME: hackish prPrt :: CF -> [String] prPrt cf = ["instance Print (Tree c) where", " prt _i e = case e of" ] ++ map prPrtCons (cf2cons cf) where prPrtCons c = " " ++ consFun c +++ unwords (vars c) +++ "->" +++ "prPrec _i" +++ show (consPrec c) +++ rhs -- for token rules, just print the string argument unquoted where rhs | isToken c = let [v] = vars c in "(doc (showString " ++ v ++ "))" | otherwise = mkRhs (vars c) (consRhs c) vars = map snd . consVars isToken c = consCat c `elem` specialCats cf prPrtList :: CF -> Cat -> [String] prPrtList cf cat = mkListRule (nil ++ one ++ cons) where nil = [" [] -> " ++ mkRhs [] its | Rule f _ its <- rules, isNilFun f] one = [" [x] -> " ++ mkRhs ["x"] its | Rule f _ its <- rules, isOneFun f] cons = [" x:xs -> " ++ mkRhs ["x","xs"] its | Rule f _ its <- rules, isConsFun f] mkListRule [] = [] mkListRule rs = ["instance Print" +++ cat +++ "where", " prt _" +++ "es = case es of"] ++ rs rules = rulesForCat cf cat mkRhs :: [String] -> [Either Cat String] -> String mkRhs args its = "(concatD [" ++ unwords (intersperse "," (mk args its)) ++ "])" where mk args (Left "#" : items) = mk args items mk (arg:args) (Left c : items) = (prt c +++ arg) : mk args items mk args (Right s : items) = ("doc (showString" +++ show s ++ ")") : mk args items mk _ _ = [] prt c = "prt" +++ show (precCat c) BNFC-2.6.0.3/src/formats/haskell-gadt/CFtoAbstractGADT.hs0000644000000000000000000001350512100475635020702 0ustar0000000000000000{- BNF Converter: GADT Abstract syntax Generator Copyright (C) 2004-2005 Author: Markus Forberg, Björn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoAbstractGADT (cf2Abstract) where import CF import Utils((+++),(++++)) import Data.List(intersperse,nub) import HaskellGADTCommon import Data.Maybe (catMaybes) -- to produce a Haskell module cf2Abstract :: Bool -> String -> CF -> String -> String cf2Abstract byteStrings name cf composOpMod = unlines $ [ "{-# OPTIONS_GHC -fglasgow-exts #-}", "module" +++ name +++ "(" ++ concat (intersperse ", " exports) ++ ")" +++ "where", "", "import " ++ composOpMod, "", "import Data.Monoid", (if byteStrings then "import qualified Data.ByteString.Char8 as BS" else ""), "", "-- Haskell module generated by the BNF converter", ""] ++ prDummyTypes cf ++ [""] ++ prTreeType byteStrings cf ++ [""] ++ prCompos cf ++ [""] ++ prShow cf ++ [""] ++ prEq cf ++ [""] ++ prOrd cf where exports = ["Tree(..)"] ++ getTreeCats cf ++ ["johnMajorEq"] ++ ["module " ++ composOpMod] getTreeCats :: CF -> [String] getTreeCats cf = nub $ filter (not . isList) $ map consCat $ cf2cons cf prDummyTypes :: CF -> [String] prDummyTypes cf = concatMap prDummyType $ getTreeCats cf where prDummyType cat = ["data" +++ t, "type" +++ cat +++ "= Tree" +++ t ] where t = mkRealType cat mkRealType :: Cat -> String mkRealType cat = cat ++ "_" -- FIXME: make sure that there is no such category already prTreeType :: Bool -> CF -> [String] prTreeType byteStrings cf = ["data Tree :: * -> * where"] ++ map ((" "++) . prTreeCons) (cf2cons cf) where prTreeCons c | isPositionCat cf cat = fun +++ ":: ((Int,Int),"++stringType++") -> Tree" +++ mkRealType cat | otherwise = fun +++ "::" +++ concat [c +++ "-> " | (c,_) <- consVars c] ++ "Tree" +++ mkRealType cat where (cat,fun) = (consCat c, consFun c) stringType | byteStrings = "BS.ByteString" | otherwise = "String" prCompos :: CF -> [String] prCompos cf = ["instance Compos Tree where", " compos r a f t = case t of"] ++ map (" "++) (concatMap prComposCons cs ++ if not (all isRecursive cs) then ["_ -> r t"] else []) where cs = cf2cons cf prComposCons c | isRecursive c = [consFun c +++ unwords (map snd (consVars c)) +++ "->" +++ rhs c] | otherwise = [] isRecursive c = any (isTreeType cf) (map fst (consVars c)) rhs c = "r" +++ consFun c +++ unwords (map prRec (consVars c)) where prRec (cat,var) | not (isTreeType cf cat) = "`a`" +++ "r" +++ var | isList cat = "`a` foldr (a . a (r (:)) . f) (r [])" +++ var | otherwise = "`a`" +++ "f" +++ var prShow :: CF -> [String] prShow cf = ["instance Show (Tree c) where", " showsPrec n t = case t of"] ++ map (" "++) (map prShowCons cs) ++ [" where opar n = if n > 0 then showChar '(' else id", " cpar n = if n > 0 then showChar ')' else id"] where cs = cf2cons cf prShowCons c | null vars = fun +++ "->" +++ "showString" +++ show fun | otherwise = fun +++ unwords (map snd vars) +++ "->" +++ "opar n . showString" +++ show fun +++ unwords [". showChar ' ' . showsPrec 1 " ++ x | (_,x) <- vars] +++ ". cpar n" where (fun, vars) = (consFun c, consVars c) prEq :: CF -> [String] prEq cf = ["instance Eq (Tree c) where (==) = johnMajorEq", "", "johnMajorEq :: Tree a -> Tree b -> Bool"] ++ map (prEqCons) (cf2cons cf) ++ ["johnMajorEq _ _ = False"] where prEqCons c | null vars = "johnMajorEq" +++ fun +++ fun +++ "=" +++ "True" | otherwise = "johnMajorEq" +++ "(" ++ fun +++ unwords vars ++ ")" +++ "(" ++ fun +++ unwords vars' ++ ")" +++ "=" +++ (concat $ intersperse " && " $ zipWith (\x y -> x +++ "==" +++ y) vars vars') where (fun, vars) = (consFun c, map snd (consVars c)) vars' = map (++"_") vars prOrd :: CF -> [String] prOrd cf = ["instance Ord (Tree c) where", " compare x y = compare (index x) (index y) `mappend` compareSame x y"] ++ ["index :: Tree c -> Int"] ++ zipWith (\ c i -> mkIndex c i) cs [0..] ++ ["compareSame :: Tree c -> Tree c -> Ordering"] ++ map mkCompareSame cs ++ ["compareSame x y = error \"BNFC error:\" compareSame"] where cs = cf2cons cf mkCompareSame c | null vars = "compareSame" +++ fun +++ fun +++ "=" +++ "EQ" | otherwise = "compareSame" +++ "(" ++ fun +++ unwords vars ++ ")" +++ "(" ++ fun +++ unwords vars' ++ ")" +++ "=" +++ foldr1 (\x y -> "mappend (" ++ x ++") ("++y++")") cc where (fun, vars) = (consFun c, map snd (consVars c)) vars' = map (++"_") vars cc = zipWith (\x y -> "compare"+++x+++y) vars vars' mkIndex c i = "index" +++ "(" ++ consFun c +++ unwords (replicate (length (consVars c)) "_") ++ ")" +++ "=" +++ show i BNFC-2.6.0.3/src/formats/haskell-gadt/CFtoTemplateGADT.hs0000644000000000000000000000410312100475635020704 0ustar0000000000000000{- BNF Converter: GADT Template Generator Copyright (C) 2004-2005 Author: Markus Forberg, Björn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoTemplateGADT ( cf2Template ) where import CF import Utils((+++)) import Data.List (delete,groupBy) import HaskellGADTCommon type ModuleName = String cf2Template :: ModuleName -> ModuleName -> ModuleName -> CF -> String cf2Template skelName absName errName cf = unlines $ [ "module "++ skelName ++ " where", "", "-- Haskell module generated by the BNF converter", "", "import " ++ absName, "import " ++ errName, "type Result = Err String\n", "failure :: Show a => a -> Result", "failure x = Bad $ \"Undefined case: \" ++ show x", "", "transTree :: Tree c -> Result", "transTree t = case t of"] ++ map prConsCase (cf2cons cf) ++ [""] ++ concatMap ((++[""]) . uncurry prCatTrans) (catCons cf) prConsCase :: Constructor -> String prConsCase c = " " ++ consFun c +++ unwords (map snd (consVars c)) +++ "-> failure t" catCons :: CF -> [(Cat,[Constructor])] catCons cf = [ (consCat (head cs),cs) | cs <- groupBy catEq $ cf2cons cf] catEq :: Constructor -> Constructor -> Bool catEq c1 c2 = consCat c1 == consCat c2 prCatTrans :: Cat -> [Constructor] -> [String] prCatTrans cat cs = ["trans" ++ cat +++ "::" +++ cat +++ "-> Result", "trans" ++ cat +++ "t = case t of"] ++ map prConsCase csBNFC-2.6.0.3/src/formats/haskell-gadt/HaskellGADTCommon.hs0000644000000000000000000000602512100475635021116 0ustar0000000000000000{- BNF Converter: Haskell GADT back-end common stuff Copyright (C) 2004-2005 Author: Markus Forberg, Björn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module HaskellGADTCommon (Constructor(..), cf2cons, isTreeType) where import CF import Data.Char data Constructor = Constructor { consCat :: Cat, consFun :: Fun, consPrec :: Int, consVars :: [(Cat,String)], consRhs :: [Either Cat String] } -- | Get category, function, and rhs categories paired with variable names. cf2cons :: CF -> [Constructor] cf2cons cf = [ Constructor { consCat = cat, consFun = fun, consPrec = precFun cf fun, consVars = zip cats (mkVars cats), consRhs = rhsFun cf fun} | (cat,rules) <- cf2data cf, (fun,cats) <- rules] ++ [ Constructor { consCat = cat, consFun = cat, consPrec = 0, consVars = [("String","str")], consRhs = [Left "String"]} | cat <- specialCats cf] where mkVars cats = mkUnique (map catToVar cats) (0 :: Int) mkUnique [] _ = [] mkUnique (x:xs) n | elem x xs || n > 0 = (x ++ show n) : mkUnique xs (n+1) | otherwise = x : mkUnique xs n -- | Make a variable name for a category. catToVar :: Cat -> String catToVar = checkRes . var where var cat | isList cat = var (normCatOfList cat) ++ "s" var "Ident" = "i" var "Integer" = "n" var "String" = "str" var "Char" = "c" var "Double" = "d" var xs = map toLower xs checkRes s | elem s reservedHaskell = s ++ "'" | otherwise = s reservedHaskell = ["case","class","data","default","deriving","do","else","if", "import","in","infix","infixl","infixr","instance","let","module", "newtype","of","then","type","where","as","qualified","hiding"] -- | Get the rule for a function. ruleFun :: CF -> Fun -> Rule ruleFun cf f = head $ filter (\r -> funRule r == f) $ rulesOfCF cf -- | Get the precedence of a function. precFun :: CF -> Fun -> Int precFun cf f = precRule $ ruleFun cf f -- | Get the RHS of a function rhsFun :: CF -> Fun -> [Either Cat String] rhsFun cf f = rhsRule $ ruleFun cf f isTreeType :: CF -> Cat -> Bool isTreeType cf c | isList c = isTreeType cf (catOfList c) | otherwise = c `elem` (allCats cf ++ specialCats cf) BNFC-2.6.0.3/src/formats/haskell-gadt/HaskellTopGADT.hs0000644000000000000000000002757312100475635020443 0ustar0000000000000000{- BNF Converter: Haskell main file Copyright (C) 2004-2005 Author: Markus Forberg, Peter Gammie, Aarne Ranta, Björn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module HaskellTopGADT (makeAllGADT) where -- import Utils import Options import HsOpts import CF import CFtoHappy import CFtoAlex import CFtoAlex2 import CFtoAlex3 import CFtoLatex import HaskellTop(AlexMode(..)) import CFtoAbstractGADT import CFtoTemplateGADT import CFtoPrinterGADT import CFtoLayout import CFtoXML import MkErrM import MkSharedString import Utils import Data.Char import Data.Maybe (fromMaybe,maybe) import System.Exit (exitFailure) import Control.Monad(when) makeAllGADT :: Options -> CF -> IO () makeAllGADT opts cf = do let absMod = absFileM opts composOpMod = composOpFileM opts lexMod = alexFileM opts parMod = happyFileM opts prMod = printerFileM opts layMod = layoutFileM opts errMod = errFileM opts shareMod = shareFileM opts do let dir = codeDir opts when (not (null dir)) $ do putStrLn $ "Creating directory " ++ dir prepareDir dir writeFileRep (absFile opts) $ cf2Abstract (byteStrings opts) absMod cf composOpMod writeFileRep (composOpFile opts) $ composOp composOpMod case alexMode opts of Alex1 -> do writeFileRep (alexFile opts) $ cf2alex lexMod errMod cf putStrLn " (Use Alex 1.1 to compile.)" Alex2 -> do writeFileRep (alexFile opts) $ cf2alex2 lexMod errMod shareMod (shareStrings opts) (byteStrings opts) cf putStrLn " (Use Alex 2.0 to compile.)" Alex3 -> do writeFileRep (alexFile opts) $ cf2alex3 lexMod errMod shareMod (shareStrings opts) (byteStrings opts) cf putStrLn " (Use Alex 3.0 to compile.)" writeFileRep (happyFile opts) $ cf2HappyS parMod absMod lexMod errMod (glr opts) (byteStrings opts) cf putStrLn " (Tested with Happy 1.15)" writeFileRep (latexFile opts) $ cfToLatex (lang opts) cf writeFileRep (templateFile opts) $ cf2Template (templateFileM opts) absMod errMod cf writeFileRep (printerFile opts) $ cf2Printer prMod absMod cf when (hasLayout cf) $ writeFileRep (layoutFile opts) $ cf2Layout (alexMode opts == Alex1) (inDir opts) layMod lexMod cf writeFileRep (tFile opts) $ testfile opts cf writeFileRep (errFile opts) $ errM errMod cf when (shareStrings opts) $ writeFileRep (shareFile opts) $ sharedString shareMod (byteStrings opts) cf when (make opts) $ writeFileRep "Makefile" $ makefile opts case xml opts of 2 -> makeXML (lang opts) True cf 1 -> makeXML (lang opts) False cf _ -> return () codeDir :: Options -> FilePath codeDir opts = let pref = maybe "" pkgToDir (inPackage opts) dir = if inDir opts then lang opts else "" sep = if null pref || null dir then "" else [pathSep] in pref ++ sep ++ dir makefile :: Options -> String makefile opts = makeA where glr_params = if glr opts == GLR then "--glr --decode " else "" dir = let d = codeDir opts in if null d then "" else d ++ [pathSep] cd c = if null dir then c else "(cd " ++ dir ++ "; " ++ c ++ ")" makeA = unlines [ "all:", "\thappy -gca " ++ glr_params ++ happyFile opts, "\talex -g " ++ alexFile opts, "\t" ++ cd ("latex " ++ basename (latexFile opts) ++ "; " ++ "dvips " ++ basename (dviFile opts) ++ " -o " ++ basename (psFile opts)), "\tghc --make " ++ tFile opts ++ " -o " ++ mkFile withLang "Test" "" opts, "clean:", "\t-rm -f " ++ unwords (map (dir++) [ "*.log", "*.aux", "*.hi", "*.o", "*.dvi" ]), "\t-rm -f " ++ psFile opts, "distclean: clean", "\t-rm -f " ++ unwords [ mkFile withLang "Doc" "*" opts, mkFile withLang "Lex" "*" opts, mkFile withLang "Par" "*" opts, mkFile withLang "Layout" "*" opts, mkFile withLang "Skel" "*" opts, mkFile withLang "Print" "*" opts, mkFile withLang "Test" "*" opts, mkFile withLang "Abs" "*" opts, mkFile withLang "ComposOp" "*" opts, mkFile withLang "Test" "" opts, mkFile noLang "ErrM" "*" opts, mkFile noLang "SharedString" "*" opts, dir ++ lang opts ++ ".dtd", mkFile withLang "XML" "*" opts, "Makefile*" ], if null dir then "" else "\t-rmdir -p " ++ dir ] testfile :: Options -> CF -> String testfile opts cf = let lay = hasLayout cf use_xml = xml opts > 0 xpr = if use_xml then "XPrint a, " else "" use_glr = glr opts == GLR if_glr s = if use_glr then s else "" firstParser = if use_glr then "the_parser" else parserName parserName = 'p' : topType topType = firstEntry cf in unlines ["-- automatically generated by BNF Converter", "module Main where\n", "", "import System.IO ( stdin, hGetContents )", "import System.Environment ( getArgs, getProgName )", "", "import " ++ alexFileM opts, "import " ++ happyFileM opts, "import " ++ templateFileM opts, "import " ++ printerFileM opts, "import " ++ absFileM opts, if lay then ("import " ++ layoutFileM opts) else "", if use_xml then ("import " ++ xmlFileM opts) else "", if_glr "import Data.FiniteMap(FiniteMap, lookupFM, fmToList)", if_glr "import Data.Maybe(fromJust)", "import " ++ errFileM opts, "", if use_glr then "type ParseFun a = [[Token]] -> (GLRResult, GLR_Output (Err a))" else "type ParseFun a = [Token] -> Err a", "", "myLLexer = " ++ if lay then "resolveLayout True . myLexer" else "myLexer", "", "type Verbosity = Int", "", "putStrV :: Verbosity -> String -> IO ()", "putStrV v s = if v > 1 then putStrLn s else return ()", "", "runFile :: (" ++ xpr ++ if_glr "TreeDecode a, " ++ "Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO ()", "runFile v p f = putStrLn f >> readFile f >>= run v p", "", "run :: (" ++ xpr ++ if_glr "TreeDecode a, " ++ "Print a, Show a) => Verbosity -> ParseFun a -> String -> IO ()", if use_glr then run_glr else run_std use_xml, "", "showTree :: (Show a, Print a) => Int -> a -> IO ()", "showTree v tree", " = do", " putStrV v $ \"\\n[Abstract Syntax]\\n\\n\" ++ show tree", " putStrV v $ \"\\n[Linearized tree]\\n\\n\" ++ printTree tree", "", "main :: IO ()", "main = do args <- getArgs", " case args of", " [] -> hGetContents stdin >>= run 2 " ++ firstParser, " \"-s\":fs -> mapM_ (runFile 0 " ++ firstParser ++ ") fs", " fs -> mapM_ (runFile 2 " ++ firstParser ++ ") fs", "", if_glr $ "the_parser :: ParseFun " ++ topType, if_glr $ "the_parser = lift_parser " ++ parserName, if_glr $ "", if_glr $ lift_parser ] run_std xml = unlines [ "run v p s = let ts = myLLexer s in case p ts of" , " Bad s -> do putStrLn \"\\nParse Failed...\\n\"" , " putStrV v \"Tokens:\"" , " putStrV v $ show ts" , " putStrLn s" , " Ok tree -> do putStrLn \"\\nParse Successful!\"" , " showTree v tree" , if xml then " putStrV v $ \"\\n[XML]\\n\\n\" ++ printXML tree" else "" ] run_glr = unlines [ "run v p s" , " = let ts = map (:[]) $ myLLexer s" , " (raw_output, simple_output) = p ts in" , " case simple_output of" , " GLR_Fail major minor -> do" , " putStrLn major" , " putStrV v minor" , " GLR_Result df trees -> do" , " putStrLn \"\\nParse Successful!\"" , " case trees of" , " [] -> error \"No results but parse succeeded?\"" , " [Ok x] -> showTree v x" , " xs@(_:_) -> showSeveralTrees v xs" , " where" , " showSeveralTrees :: (Print b, Show b) => Int -> [Err b] -> IO ()" , " showSeveralTrees v trees" , " = sequence_ " , " [ do putStrV v (replicate 40 '-')" , " putStrV v $ \"Parse number: \" ++ show n" , " showTree v t" , " | (Ok t,n) <- zip trees [1..]" , " ]" ] lift_parser = unlines [ "type Forest = FiniteMap ForestId [Branch] -- omitted in ParX export." , "data GLR_Output a" , " = GLR_Result { pruned_decode :: (Forest -> Forest) -> [a]" , " , semantic_result :: [a]" , " }" , " | GLR_Fail { main_message :: String" , " , extra_info :: String" , " }" , "" , "lift_parser" , " :: (TreeDecode a, Show a, Print a)" , " => ([[Token]] -> GLRResult) -> ParseFun a" , "lift_parser parser ts" , " = let result = parser ts in" , " (\\o -> (result, o)) $" , " case result of" , " ParseError ts f -> GLR_Fail \"Parse failed, unexpected token(s)\\n\"" , " (\"Tokens: \" ++ show ts)" , " ParseEOF f -> GLR_Fail \"Parse failed, unexpected EOF\\n\"" , " (\"Partial forest:\\n\"" , " ++ unlines (map show $ fmToList f))" , " ParseOK r f -> let find f = fromJust . lookupFM f" , " dec_fn f = decode (find f) r" , " in GLR_Result (\\ff -> dec_fn $ ff f) (dec_fn f)" ] composOp :: String -> String composOp composOpMod = unlines [ "{-# OPTIONS_GHC -fglasgow-exts #-}", "module " ++ composOpMod ++ " (Compos(..),composOp,composOpM,composOpM_,composOpMonoid,", " composOpMPlus,composOpFold) where", "", "import Control.Monad.Identity", "import Data.Monoid", "", "class Compos t where", " compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)", " -> (forall a. t a -> m (t a)) -> t c -> m (t c)", "", "composOp :: Compos t => (forall a. t a -> t a) -> t c -> t c", "composOp f = runIdentity . composOpM (Identity . f)", "", "composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t c -> m (t c)", "composOpM = compos return ap", "", "composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t c -> m ()", "composOpM_ = composOpFold (return ()) (>>)", "", "composOpMonoid :: (Compos t, Monoid m) => (forall a. t a -> m) -> t c -> m", "composOpMonoid = composOpFold mempty mappend", "", "composOpMPlus :: (Compos t, MonadPlus m) => (forall a. t a -> m b) -> t c -> m b", "composOpMPlus = composOpFold mzero mplus", "", "composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b", "composOpFold z c f = unC . compos (\\_ -> C z) (\\(C x) (C y) -> C (c x y)) (C . f)", "", "newtype C b a = C { unC :: b }" ] BNFC-2.6.0.3/src/formats/f-sharp/0000755000000000000000000000000012100475635014363 5ustar0000000000000000BNFC-2.6.0.3/src/formats/f-sharp/FSharpTop.hs0000644000000000000000000001641312100475635016572 0ustar0000000000000000{- BNF Converter: F# main file Copyright (C) 2005 Author: Kristofer Johannisson Copyright (C) 2007 Author: Bjorn Bringert 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- based on BNFC O'Caml backend module FSharpTop (makeFSharp) where import CF import CFtoOCamlYacc import CFtoOCamlLex import CFtoLatex import CFtoOCamlAbs import CFtoOCamlTemplate import CFtoOCamlPrinter import CFtoOCamlShow import CFtoOCamlTest import CFtoXML import Utils import Options import Data.Char import Data.Maybe (fromMaybe,maybe) import System.Exit (exitFailure) import Control.Monad(when) -- naming conventions noLang :: Options -> String -> String noLang _ name = name withLang :: Options -> String -> String withLang opts name = name ++ lang opts mkMod :: (Options -> String -> String) -> String -> Options -> String mkMod addLang name opts = pref ++ if inDir opts then lang opts ++ "." ++ name else addLang opts name where pref = maybe "" (++".") (inPackage opts) mkFile :: (Options -> String -> String) -> String -> String -> Options -> FilePath mkFile addLang name ext opts = pref ++ if inDir opts then lang opts ++ [pathSep] ++ name ++ ext' else addLang opts name ++ if null ext then "" else ext' where pref = maybe "" (\p->pkgToDir p++[pathSep]) (inPackage opts) ext' = if null ext then "" else "." ++ ext absFile, absFileM, ocamllexFile, ocamllexFileM, dviFile, ocamlyaccFile, ocamlyaccFileM, latexFile, utilFile, utilFileM, templateFile, templateFileM, printerFile, printerFileM, psFile, tFile, tFileM :: Options -> String absFile = mkFile withLang "Abs" "ml" absFileM = mkMod withLang "Abs" ocamllexFile = mkFile withLang "Lex" "mll" ocamllexFileM = mkMod withLang "Lex" ocamlyaccFile = mkFile withLang "Par" "mly" ocamlyaccFileM = mkMod withLang "Par" latexFile = mkFile withLang "Doc" "tex" templateFile = mkFile withLang "Skel" "ml" templateFileM = mkMod withLang "Skel" printerFile = mkFile withLang "Print" "ml" printerFileM = mkMod withLang "Print" showFile = mkFile withLang "Show" "ml" showFileM = mkMod withLang "Show" dviFile = mkFile withLang "Doc" "dvi" psFile = mkFile withLang "Doc" "ps" tFile = mkFile withLang "Test" "ml" tFileM = mkMod withLang "Test" utilFile = mkFile noLang "BNFC_Util" "ml" utilFileM = mkMod noLang "BNFC_Util" xmlFileM = mkMod withLang "XML" type Options = SharedOptions makeFSharp :: Options -> CF -> IO () makeFSharp opts cf = do let absMod = absFileM opts lexMod = ocamllexFileM opts parMod = ocamlyaccFileM opts prMod = printerFileM opts showMod = showFileM opts -- layMod = layoutFileM opts utilMod = utilFileM opts do let dir = codeDir opts when (not (null dir)) $ do putStrLn $ "Creating directory " ++ dir prepareDir dir writeFileRep (absFile opts) $ cf2Abstract absMod cf writeFileRep (ocamllexFile opts) $ cf2ocamllex lexMod parMod cf writeFileRep (ocamlyaccFile opts) $ cf2ocamlyacc parMod absMod lexMod cf writeFileRep (latexFile opts) $ cfToLatex (lang opts) cf writeFileRep (templateFile opts) $ cf2Template (templateFileM opts) absMod cf writeFileRep (printerFile opts) $ cf2Printer prMod absMod cf writeFileRep (showFile opts) $ cf2show showMod absMod cf writeFileRep (tFile opts) $ ocamlTestfile absMod lexMod parMod prMod showMod cf writeFileRep (utilFile opts) $ utilM when (make opts) $ writeFileRep "Makefile" $ makefile opts case xml opts of 2 -> makeXML (lang opts) True cf 1 -> makeXML (lang opts) False cf _ -> return () pkgToDir :: String -> FilePath pkgToDir s = replace '.' pathSep s codeDir :: Options -> FilePath codeDir opts = let pref = maybe "" pkgToDir (inPackage opts) dir = if inDir opts then lang opts else "" sep = if null pref || null dir then "" else [pathSep] in pref ++ sep ++ dir makefile :: Options -> String makefile opts = makeA where dir = let d = codeDir opts in if null d then "" else d ++ [pathSep] cd c = if null dir then c else "(cd " ++ dir ++ "; " ++ c ++ ")" makeA = unlines [ "all:", "\tfsyacc " ++ ocamlyaccFile opts, "\tfslex " ++ ocamllexFile opts, "\t" ++ cd ("latex " ++ basename (latexFile opts) ++ "; " ++ "dvips " ++ basename (dviFile opts) ++ " -o " ++ basename (psFile opts)), "\tfsc -o " ++ mkFile withLang "Test" "exe" opts +++ utilFile opts +++ absFile opts +++ templateFile opts +++ showFile opts +++ printerFile opts +++ mkFile withLang "Par" "mli" opts +++ mkFile withLang "Par" "ml" opts +++ mkFile withLang "Lex" "fs" opts +++ tFile opts, "", "clean:", "\t-rm -f " ++ unwords (map (dir++) [ "*.log", "*.aux", "*.cmi", "*.cmo", "*.o", "*.dvi" ]), "\t-rm -f " ++ psFile opts, "", "distclean: clean", "\t-rm -f " ++ unwords [ mkFile withLang "Doc" "*" opts, mkFile withLang "Lex" "*" opts, mkFile withLang "Par" "*" opts, mkFile withLang "Layout" "*" opts, mkFile withLang "Skel" "*" opts, mkFile withLang "Print" "*" opts, mkFile withLang "Show" "*" opts, mkFile withLang "Test" "*" opts, mkFile withLang "Abs" "*" opts, mkFile withLang "Test" "" opts, utilFile opts, "Makefile*" ] ] utilM :: String utilM = unlines ["(* automatically generated by BNFC *)", "", "open Lexing", "", "(* this should really be in the parser, but ocamlyacc won't put it in the .mli *)", "exception Parse_error of Lexing.position * Lexing.position" ] BNFC-2.6.0.3/src/formats/ocaml/0000755000000000000000000000000012100475635014116 5ustar0000000000000000BNFC-2.6.0.3/src/formats/ocaml/CFtoOCamlPrinter.hs0000644000000000000000000001575612100475635017603 0ustar0000000000000000{- BNF Converter: Pretty-printer generator Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- based on BNFC Haskell backend module CFtoOCamlPrinter (cf2Printer) where import CF import Utils import CFtoTemplate import Data.List (intersperse) import Data.Char(toLower,isDigit) import OCamlUtil -- derive pretty-printer from a BNF grammar. AR 15/2/2002 cf2Printer :: String -> String -> CF -> String cf2Printer name absMod cf = unlines [ prologue name absMod, charRule cf, integerRule cf, doubleRule cf, stringRule cf, if hasIdent cf then identRule cf else "", unlines [ownPrintRule cf own | (own,_) <- tokenPragmas cf], rules cf ] prologue :: String -> String -> String prologue name absMod = unlines [ "(* pretty-printer generated by the BNF converter *)\n", "open " ++ absMod, "open Printf", "", "(* We use string buffers for efficient string concatenation.", " A document takes a buffer and an indentation, has side effects on the buffer", " and returns a new indentation. The indentation argument indicates the level", " of indentation to be used if a new line has to be started (because of what is", " already in the buffer) *)", "type doc = Buffer.t -> int -> int", "", "let rec printTree (printer : int -> 'a -> doc) (tree : 'a) : string = ", " let buffer_init_size = 16 (* you may want to change this *)", " in let buffer = Buffer.create buffer_init_size", " in ", " let _ = printer 0 tree buffer 0 in (* discard return value *)", " Buffer.contents buffer", "", "let indent_width = 4", "", "let indent (i: int) : string = ", " let s = String.make (i+1) ' ' in", " String.set s 0 '\\n';", " s", "", "(* this render function is written for C-style languages, you may want to change it *)", "let render (s : string) : doc = fun buf i -> ", " (* invariant: last char of the buffer is never whitespace *)", " let n = Buffer.length buf in", " let last = if n = 0 then None else Some (Buffer.nth buf (n-1)) in", " let whitespace = match last with", " None -> \"\" ", " | Some '{' -> indent i", " | Some '}' -> (match s with", " \";\" -> \"\"", " | _ -> indent i)", " | Some ';' -> indent i", " | (Some '[') | (Some '(') -> \"\"", " | Some _ -> (match s with", " \",\" | \")\" | \"]\" -> \"\"", " | _ -> \" \") in", " let newindent = match s with", " \"{\" -> i + indent_width", " | \"}\" -> i - indent_width", " | _ -> i in", " Buffer.add_string buf whitespace;", " Buffer.add_string buf s;", " newindent", "", "let emptyDoc : doc = fun buf i -> i", "", "let concatD (ds : doc list) : doc = fun buf i -> ", " List.fold_left (fun accIndent elemDoc -> elemDoc buf accIndent) (emptyDoc buf i) ds", "", "let parenth (d:doc) : doc = concatD [render \"(\"; d; render \")\"]", "", "let prPrec (i:int) (j:int) (d:doc) : doc = if j String rules cf = unlines $ mutualDefs $ map (\(s,xs) -> case_fun s (map toArgs xs) ++ ifList cf s) $ cf2data cf where toArgs (cons,args) = ((cons, names (map (checkRes . var) args) (0 :: Int)), ruleOf cons) names [] _ = [] names (x:xs) n | elem x xs = (x ++ show n) : names xs (n+1) | otherwise = x : names xs n var ('[':xs) = var (init xs) ++ "s" var "Ident" = "id" var "Integer" = "n" var "String" = "str" var "Char" = "c" var "Double" = "d" var xs = map toLower xs checkRes s | elem s reservedOCaml = s ++ "'" | otherwise = s ruleOf s = maybe undefined id $ lookupRule s (rulesOfCF cf) --- case_fun :: Cat -> [(Constructor,Rule)] -> String case_fun cat xs = unlines [ -- "instance Print" +++ cat +++ "where", prtFun cat +++"(i:int)" +++ "(e:" ++ fixType cat ++ ") : doc = match e with", unlines $ insertBar $ map (\ ((c,xx),r) -> " " ++ c +++ mkTuple xx +++ "->" +++ "prPrec i" +++ show (precCat (fst r)) +++ mkRhs xx (snd r)) xs ] ifList cf cat = mkListRule $ nil cat ++ one cat ++ cons cat where nil cat = [" [] -> " ++ mkRhs [] its | Rule f c its <- rulesOfCF cf, isNilFun f , normCatOfList c == cat] one cat = [" | [x] -> " ++ mkRhs ["x"] its | Rule f c its <- rulesOfCF cf, isOneFun f , normCatOfList c == cat] cons cat = [" | x::xs -> " ++ mkRhs ["x","xs"] its | Rule f c its <- rulesOfCF cf, isConsFun f , normCatOfList c == cat] mkListRule [] = "" mkListRule rs = unlines $ ("and prt" ++ fixTypeUpper cat ++ "ListBNFC" +++ "_ es : doc = match es with"):rs mkRhs args its = "(concatD [" ++ unwords (intersperse ";" (mk args its)) ++ "])" where mk args (Left "#" : items) = mk args items mk (arg:args) (Left c : items) = (prt c +++ arg) : mk args items mk args (Right s : items) = ("render " ++ show s) : mk args items mk _ _ = [] prt c = prtFun c +++ show (precCat c) prtFun :: Cat -> String prtFun c = case c of '[':xs -> case break (== ']') xs of (t,"]") -> prtFun t ++ "ListBNFC" _ -> c -- should not occur (this means an invariant of the type Cat is broken) _ -> if precCat c > 0 -- precedence-level cats are not in abstract syntax then "prt" ++ (fixTypeUpper $ reverse (dropWhile isDigit (reverse c))) else "prt" ++ (fixTypeUpper c) BNFC-2.6.0.3/src/formats/ocaml/CFtoOCamlAbs.hs0000644000000000000000000000423312100475635016651 0ustar0000000000000000{- BNF Converter: OCaml Abstract Syntax Generator Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- based on BNFC Haskell backend module CFtoOCamlAbs (cf2Abstract) where import CF import Utils((+++),(++++)) import Data.List(intersperse) import OCamlUtil -- to produce an OCaml module cf2Abstract :: String -> CF -> String cf2Abstract name cf = unlines $ "(* OCaml module generated by the BNF converter *)\n\n" : mutualRecDefs (map (prSpecialData cf) (specialCats cf) ++ map prData (cf2data cf)) -- allow mutual recursion so that we do not have to sort the type definitions in -- dependency order mutualRecDefs :: [String] -> [String] mutualRecDefs ss = case ss of [] -> [] [x] -> ["type" +++ x] x:xs -> ("type" +++ x) : map ("and" +++) xs prData :: Data -> String prData (cat,rules) = fixType cat +++ "=\n " ++ concat (intersperse "\n | " (map prRule rules)) ++ "\n" prRule (fun,[]) = fun prRule (fun,cats) = fun +++ "of" +++ mkTupleType cats mkTupleType [c] = fixType c mkTupleType (c:cs) = fixType c +++ "*" +++ mkTupleType cs prSpecialData :: CF -> Cat -> String prSpecialData cf cat = fixType cat +++ "=" +++ cat +++ "of" +++ contentSpec cf cat -- unwords ["newtype",cat,"=",cat,contentSpec cf cat,"deriving (Eq,Ord,Show)"] contentSpec :: CF -> Cat -> String contentSpec cf cat = -- if isPositionCat cf cat then "((Int,Int),String)" else "String" if isPositionCat cf cat then "((int * int) * string)" else "string"BNFC-2.6.0.3/src/formats/ocaml/CFtoOCamlLex.hs0000644000000000000000000002063712100475635016702 0ustar0000000000000000{- BNF Converter: ocamllex Generator Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- based on BNFC Haskell backend module CFtoOCamlLex (cf2ocamllex) where import Data.List import Data.Char import CF import AbsBNF import CFtoOCamlYacc (terminal) import Utils ((+++)) cf2ocamllex :: String -> String -> CF -> String cf2ocamllex name parserMod cf = unlines $ concat $ intersperse [""] [ header parserMod cf, definitions cf, let r = rules cf in case r of [] -> [] x:xs -> ("rule" +++ x) : map ("and" +++) xs ] header :: String -> CF -> [String] header parserMod cf = [ "(* This ocamllex file was machine-generated by the BNF converter *)", "{", "open " ++ parserMod, "open Lexing", "", hashtables cf, "", "let unescapeInitTail (s:string) : string =", " let rec unesc s = match s with", " '\\\\'::c::cs when List.mem c ['\\\"'; '\\\\'; '\\\''] -> c :: unesc cs", " | '\\\\'::'n'::cs -> '\\n' :: unesc cs", " | '\\\\'::'t'::cs -> '\\t' :: unesc cs", " | '\\\"'::[] -> []", " | c::cs -> c :: unesc cs", " | _ -> []", " (* explode/implode from caml FAQ *)", " in let explode (s : string) : char list =", " let rec exp i l =", " if i < 0 then l else exp (i - 1) (s.[i] :: l) in", " exp (String.length s - 1) []", " in let implode (l : char list) : string =", " let res = String.create (List.length l) in", " let rec imp i = function", " | [] -> res", " | c :: l -> res.[i] <- c; imp (i + 1) l in", " imp 0 l", " in implode (unesc (List.tl (explode s)))", "", "let incr_lineno (lexbuf:Lexing.lexbuf) : unit =", " let pos = lexbuf.lex_curr_p in", " lexbuf.lex_curr_p <- { pos with", " pos_lnum = pos.pos_lnum + 1;", " pos_bol = pos.pos_cnum;", " }", "}" ] -- | set up hashtables for reserved symbols and words hashtables :: CF -> String hashtables cf = ht "symbol_table" (symbols cf ) ++ "\n" ++ ht "resword_table" (reservedWords cf) where ht table syms | length syms == 0 = "" ht table syms = unlines [ "let" +++ table +++ "= Hashtbl.create " ++ show (length syms), "let _ = List.iter (fun (kwd, tok) -> Hashtbl.add" +++ table +++ "kwd tok)", " [" ++ concat (intersperse ";" keyvals) ++ "]" ] where keyvals = map (\(x,y) -> "(" ++ x ++ ", " ++ y ++ ")") (zip (map show syms) (map (terminal cf) syms)) definitions :: CF -> [String] definitions cf = concat [ cMacros, rMacros cf ] cMacros :: [String] cMacros = [ "let l = ['a'-'z' 'A'-'Z' '\\192' - '\\255'] # ['\\215' '\\247'] (* isolatin1 letter FIXME *)", "let c = ['A'-'Z' '\\192'-'\\221'] # ['\\215'] (* capital isolatin1 letter FIXME *)", "let s = ['a'-'z' '\\222'-'\\255'] # ['\\247'] (* small isolatin1 letter FIXME *)", "let d = ['0'-'9'] (* digit *)", "let i = l | d | ['_' '\\''] (* identifier character *)", "let u = ['\\000'-'\\255'] (* universal: any character *)" ] rMacros :: CF -> [String] rMacros cf = let symbs = symbols cf in (if null symbs then [] else [ "let rsyms = (* reserved words consisting of special symbols *)", " " ++ unwords (intersperse "|" (map mkEsc symbs)) ]) where mkEsc s = "\"" ++ concat (map f s) ++ "\"" f x = if x `elem` ['"','\\'] then "\\" ++ [x] else [x] rules :: CF -> [String] rules cf = oneRule $ concat [ lexComments (comments cf), ["l i* " ++ case reservedWords cf of [] -> "{let id = lexeme lexbuf in TOK_Ident id}" _ -> "{let id = lexeme lexbuf in try Hashtbl.find resword_table id with Not_found -> TOK_Ident id}" ], if null (symbols cf) then [] else ["rsyms {let id = lexeme lexbuf in try Hashtbl.find symbol_table id with Not_found -> failwith (\"internal lexer error: reserved symbol \" ^ id ^ \" not found in hashtable\")}"], ["d+ {let i = lexeme lexbuf in TOK_Integer (int_of_string i)}"], ["d+ '.' d+ ('e' ('-')? d+)? {let f = lexeme lexbuf in TOK_Double (float_of_string f)}"], ["'\\\"' ((u # ['\\\"' '\\\\' '\\n']) | ('\\\\' ('\\\"' | '\\\\' | '\\\'' | 'n' | 't')))* '\\\"' {let s = lexeme lexbuf in TOK_String (unescapeInitTail s)}"], ["[' ' '\\t'] {token lexbuf}"], ["'\\n' {incr_lineno lexbuf; token lexbuf}"], ["eof { TOK_EOF }"] ] where oneRule xs = ["token = \n parse " ++ concat (intersperse "\n | " xs)] lexComments ([],[]) = [] lexComments (xs,s1:ys) = ('\"' : s1 ++ "\"" ++ " (_ # '\\n')* { token lexbuf } (* Toss single line comments *)") : lexComments (xs, ys) lexComments (([l1,l2],[r1,r2]):xs,[]) = (concat $ [ ('\"':l1:l2:"\" ((u # ['"), -- FIXME quotes or escape? (l2:"']) | '"), (r1:"' (u # ['"), (r2:"']))* ('"), (r1:"')+ '"), (r2:"' { token lexbuf } \n") ]) : lexComments (xs, []) lexComments ((_:xs),[]) = lexComments (xs,[]) ------------------------------------------------------------------- -- Modified from the inlined version of @RegToAlex@. ------------------------------------------------------------------- -- modified from pretty-printer generated by the BNF converter -- the top-level printing method printRegOCaml :: Reg -> String printRegOCaml = render . prt 0 -- you may want to change render and parenth render :: [String] -> String render = rend 0 where rend :: Int -> [String] -> String rend i ss = case ss of "[" :ts -> cons "[" $ rend i ts "(" :ts -> cons "(" $ rend i ts t : "," :ts -> cons t $ space "," $ rend i ts t : ")" :ts -> cons t $ cons ")" $ rend i ts t : "]" :ts -> cons t $ cons "]" $ rend i ts t :ts -> space t $ rend i ts _ -> "" cons s t = s ++ t new i s = s space t s = if null s then t else t ++ " " ++ s parenth :: [String] -> [String] parenth ss = ["("] ++ ss ++ [")"] -- the printer class does the job class Print a where prt :: Int -> a -> [String] prtList :: [a] -> [String] prtList = concat . map (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = [show c] -- if isAlphaNum c then [[c]] else ['\\':[c]] prtList s = [show s] -- map (concat . prt 0) s prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (concat [prt 2 reg0 , prt 3 reg]) RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg]) RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg]) RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]]) RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]]) ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]]) REps -> prPrec i 3 (["\"\""]) -- special construct for eps in ocamllex? RChar c -> prPrec i 3 (concat [prt 0 c]) RAlts str -> prPrec i 3 (concat [["["],prt 0 (concatMap show str),["]"]]) RSeqs str -> prPrec i 2 (concat (map (prt 0) str)) RDigit -> prPrec i 3 (concat [["digit"]]) RLetter -> prPrec i 3 (concat [["letter"]]) RUpper -> prPrec i 3 (concat [["upper"]]) RLower -> prPrec i 3 (concat [["lower"]]) RAny -> prPrec i 3 (concat [["univ"]]) BNFC-2.6.0.3/src/formats/ocaml/OCamlUtil.hs0000644000000000000000000000473212100475635016311 0ustar0000000000000000{- BNF Converter: OCaml backend utility module Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module OCamlUtil where import CF import Utils import Data.Char (toLower, toUpper) -- Translate Haskell types to OCaml types -- Note: OCaml (data-)types start with lowercase letter fixType :: Cat -> String fixType s = case s of '[':xs -> case break (== ']') xs of (t,"]") -> fixType t +++ "list" _ -> s -- should not occur (this means an invariant of the type Cat is broken) "Integer" -> "int" "Double" -> "float" c:cs -> let ls = toLower c : cs in if (elem ls reservedOCaml) then (ls ++ "T") else ls _ -> s -- as fixType, but leave first character in upper case fixTypeUpper :: Cat -> String fixTypeUpper c = case fixType c of [] -> [] c:cs -> toUpper c : cs reservedOCaml :: [String] reservedOCaml = [ "and","as","assert","asr","begin","class", "constraint","do","done","downto","else","end", "exception","external","false","for","fun","function", "functor","if","in","include","inherit","initializer", "land","lazy","let","lor","lsl","lsr", "lxor","match","method","mod","module","mutable", "new","object","of","open","or","private", "rec","sig","struct","then","to","true", "try","type","val","virtual","when","while","with"] mkTuple :: [String] -> String mkTuple [] = "" mkTuple [x] = x mkTuple (x:xs) = "(" ++ foldl (\acc e -> acc ++ "," +++ e) x xs ++ ")" insertBar :: [String] -> [String] insertBar [] = [] insertBar [x] = [" " ++ x] insertBar (x:xs) = (" " ++ x ) : map (" | " ++) xs mutualDefs :: [String] -> [String] mutualDefs defs = case defs of [] -> [] [d] -> ["let rec" +++ d] d:ds -> ("let rec" +++ d) : map ("and" +++) ds BNFC-2.6.0.3/src/formats/ocaml/CFtoOCamlShow.hs0000644000000000000000000001220512100475635017062 0ustar0000000000000000{- BNF Converter: Non-pretty-printer generator (no "deriving Show" in OCaml...) Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- there is no "deriving Show" in OCaml, although there are solutions based -- on camlp4. Here we generate our own "show module". module CFtoOCamlShow (cf2show) where import CF import Utils import CFtoTemplate import Data.List (intersperse) import Data.Char(toLower,isDigit) import OCamlUtil cf2show :: String -> String -> CF -> String cf2show name absMod cf = unlines [ prologue name absMod, integerRule cf, doubleRule cf, if hasIdent cf then identRule cf else "", unlines [ownPrintRule cf own | (own,_) <- tokenPragmas cf], rules cf ] prologue :: String -> String -> String prologue name absMod = unlines [ "(* show functions generated by the BNF converter *)\n", "open " ++ absMod, "", "(* use string buffers for efficient string concatenations *)", "type showable = Buffer.t -> unit", "", "let show (s : showable) : string = ", " let init_size = 16 in (* you may want to adjust this *)", " let b = Buffer.create init_size in", " s b;", " Buffer.contents b", " ", "let emptyS : showable = fun buf -> ()", "", "let c2s (c:char) : showable = fun buf -> Buffer.add_char buf c", "let s2s (s:string) : showable = fun buf -> Buffer.add_string buf s", "", "let ( >> ) (s1 : showable) (s2 : showable) : showable = fun buf -> s1 buf; s2 buf", "", "let showChar (c:char) : showable = fun buf -> ", " Buffer.add_string buf (\"'\" ^ Char.escaped c ^ \"'\")", "", "let showString (s:string) : showable = fun buf -> ", " Buffer.add_string buf (\"\\\"\" ^ String.escaped s ^ \"\\\"\")", "", "let showList (showFun : 'a -> showable) (xs : 'a list) : showable = fun buf -> ", " let rec f ys = match ys with", " [] -> ()", " | [y] -> showFun y buf", " | y::ys -> showFun y buf; Buffer.add_string buf \"; \"; f ys ", " in", " Buffer.add_char buf '[';", " f xs;", " Buffer.add_char buf ']'", "" ] integerRule cf = "let showInt (i:int) : showable = s2s (string_of_int i)" doubleRule cf = "let showFloat (f:float) : showable = s2s (string_of_float f)" identRule cf = ownPrintRule cf "Ident" ownPrintRule cf own = unlines $ [ "let rec" +++ showsFun own +++ "(" ++ own ++ posn ++ ") : showable = s2s \"" ++ own ++ " \" >> showString i" ] where posn = if isPositionCat cf own then " (_,i)" else " i" -- copy and paste from CFtoTemplate rules :: CF -> String rules cf = unlines $ mutualDefs $ map (\(s,xs) -> case_fun s (map toArgs xs)) $ cf2data cf -- ++ ifList cf s where toArgs (cons,args) = ((cons, names (map (checkRes . var) args) (0 :: Int)), ruleOf cons) names [] _ = [] names (x:xs) n | elem x xs = (x ++ show n) : names xs (n+1) | otherwise = x : names xs n var ('[':xs) = var (init xs) ++ "s" var "Ident" = "id" var "Integer" = "n" var "String" = "str" var "Char" = "c" var "Double" = "d" var xs = map toLower xs checkRes s | elem s reservedOCaml = s ++ "'" | otherwise = s ruleOf s = maybe undefined id $ lookupRule s (rulesOfCF cf) --- case_fun :: Cat -> [(Constructor,Rule)] -> String case_fun cat xs = unlines [ -- "instance Print" +++ cat +++ "where", showsFun cat +++ "(e:" ++ fixType cat ++ ") : showable = match e with", unlines $ insertBar $ map (\ ((c,xx),r) -> " " ++ c +++ mkTuple xx +++ "->" +++ "s2s" +++ show c +++ case mkRhs xx (snd r) of {[] -> []; str -> ">> c2s ' ' >> " ++ str} ) xs ] mkRhs args its = case unwords (intersperse " >> s2s \", \" >> " (mk args its)) of [] -> "" str -> "c2s '(' >> " ++ str ++ " >> c2s ')'" where mk args (Left "#" : items) = mk args items mk (arg:args) (Left c : items) = (showsFun c +++ arg) : mk args items mk args (Right s : items) = mk args items mk _ _ = [] prt c = showsFun c +++ show (precCat c) showsFun :: Cat -> String showsFun c = case c of '[':xs -> case break (== ']') xs of (t,"]") -> "showList" +++ showsFun t -- showFun t ++ "List" _ -> c -- should not occur (this means an invariant of the type Cat is broken) _ -> if precCat c > 0 -- precedence-level cats are not in abstract syntax then "show" ++ (fixTypeUpper $ reverse (dropWhile isDigit (reverse c))) else "show" ++ (fixTypeUpper c) BNFC-2.6.0.3/src/formats/ocaml/CFtoOCamlTest.hs0000644000000000000000000000516212100475635017065 0ustar0000000000000000{- BNF Converter: Generate main/test module for OCaml Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoOCamlTest where import CF import Utils import OCamlUtil ocamlTestfile :: String -> String -> String -> String -> String -> CF -> String ocamlTestfile absM lexM parM printM showM cf = let lexerName = lexM ++ ".token" parserName = parM ++ ".p" ++ topTypeC printerName = printM ++ ".printTree " ++ printM ++ ".prt" ++ topTypeC showFun = "(fun x -> " ++ showM ++ ".show (" ++ showM ++ ".show" ++ topTypeC ++ " x))" topTypeC = fixTypeUpper (firstEntry cf) topType = absM ++ "." ++ fixType (firstEntry cf) in unlines [ "(* automatically generated by the BNF Converter *)", "", "open Lexing", "", "let parse (c : in_channel) : " ++ topType ++ " = ", " " ++ parserName +++ lexerName +++ "(Lexing.from_channel c)", ";;", "", "let showTree (t : " ++ topType ++ ") : string = ", " \"[Abstract syntax]\\n\\n\" ^ " ++ showFun +++ "t" ++ " ^ \"\\n\\n\" ^", " \"[Linearized tree]\\n\\n\" ^ " ++ printerName +++ "t" ++ " ^ \"\\n\"", ";;", "", "let main () =", " let channel =", " if Array.length Sys.argv > 1 then", " open_in Sys.argv.(1)", " else", " stdin", " in", " try", " print_string (showTree (parse channel));", " flush stdout", " with BNFC_Util.Parse_error (start_pos, end_pos) ->", -- " ++ parM ++ ". " Printf.printf \"Parse error at %d.%d-%d.%d\\n\"", " start_pos.pos_lnum (start_pos.pos_cnum - start_pos.pos_bol)", " end_pos.pos_lnum (end_pos.pos_cnum - end_pos.pos_bol);", ";;", "", "main ();;", "" ] BNFC-2.6.0.3/src/formats/ocaml/CFtoOCamlYacc.hs0000644000000000000000000001676512100475635017040 0ustar0000000000000000{- BNF Converter: ocamlyacc Generator Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- based on BNFC Haskell backend module CFtoOCamlYacc ( cf2ocamlyacc, terminal ) where import CF import Data.List (intersperse,nub) import Data.Char import Utils ((+++)) import OCamlUtil -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type NonTerminal = String type Pattern = String type Action = String type MetaVar = String -- default naming tokenName = "Token" -- The main function, that given a CF -- generates a ocamlyacc module. cf2ocamlyacc :: String -> String -> String -> CF -> String cf2ocamlyacc name absName lexName cf = unlines [header name absName lexName, declarations absName cf, "%%", rules cf ] header :: String -> String -> String -> String header modName absName lexName = unlines ["/* This ocamlyacc file was machine-generated by the BNF converter */", "%{", "open " ++ absName, "open Lexing", "%}" ] declarations :: String -> CF -> String declarations absName cf = unlines [tokens (symbols cf) (reservedWords cf), specialTokens cf, entryPoints absName cf ] tokens :: [String] -> [String] -> String tokens symbols reswords = unlines [ if (length reswords) > 0 then "%token" +++ concat (intersperse " " (map ("TOK_" ++) reswords)) else "" , concatMap (\(s,n) -> "\n%token SYMB" ++ (show n) +++ "/*" +++ s +++ "*/") (zip symbols [1..]) ] -- | map a CF terminal into a ocamlyacc token terminal :: CF -> String -> String terminal cf s | s `elem` reservedWords cf = "TOK_" ++ s terminal cf s = case lookup s (zip (symbols cf) [1..]) of Just i -> "SYMB" ++ show i Nothing -> error $ "CFtoOCamlYacc: terminal " ++ show s ++ " not defined in CF." -- | map a CF nonterminal into a ocamlyacc symbol nonterminal :: Cat -> String nonterminal c = map spaceToUnderscore (fixType c) where spaceToUnderscore ' ' = '_' spaceToUnderscore x = x specialTokens :: CF -> String specialTokens cf = unlines ("%token TOK_EOF" : map aux (nub $ ["Ident","String","Integer","Double","Char"] ++ literals cf)) where aux cat = "%token" +++ (case cat of "Ident" -> "" "String" -> "" "Integer" -> "" "Double" -> "" "Char" -> "" own -> "" ) +++ "TOK_" ++ cat entryPoints :: String -> CF -> String entryPoints absName cf = unlines $ ("%start" +++ concat (intersperse " " (map epName eps))) : (map typing eps) where eps = (nub $ map normCat (allEntryPoints cf)) typing :: Cat -> String typing c = "%type" +++ "<" ++ qualify c ++ ">" +++ epName c qualify c = if c `elem` ["Integer","Double","Char","String", "[Integer]","[Double]","[Char]","[String]"] then fixType c else absName ++ "." ++ fixType c epName :: Cat -> String epName c = "p" ++ capitalize (nonterminal c) where capitalize s = case s of [] -> [] c:cs -> toUpper c : cs entryPointRules :: CF -> String entryPointRules cf = unlines $ map mkRule (nub $ map normCat (allEntryPoints cf)) where mkRule :: String -> String mkRule s = unlines [ epName s ++ " : " ++ nonterminal s ++ " TOK_EOF { $1 }", " | error { raise (BNFC_Util.Parse_error (Parsing.symbol_start_pos (), Parsing.symbol_end_pos ())) };" ] rules :: CF -> String rules cf = unlines [ entryPointRules cf, (unlines $ map (prOne . mkOne) (ruleGroups cf)), specialRules cf ] where mkOne (cat,rules) = constructRule cf rules cat prOne (nt,[]) = [] -- nt has only internal use prOne (nt,((p,a):ls)) = unwords [nt', ":" , p, "{", a, "}", "\n" ++ pr ls] ++ ";\n" where nt' = nonterminal nt pr [] = [] pr ((p,a):ls) = unlines [(concat $ intersperse " " [" |", p, "{", a , "}"])] ++ pr ls -- For every non-terminal, we construct a set of rules. A rule is a sequence of -- terminals and non-terminals, and an action to be performed -- As an optimization, a pair of list rules [C] ::= "" | C k [C] -- is left-recursivized into [C] ::= "" | [C] C k. -- This could be generalized to cover other forms of list rules. constructRule :: CF -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule cf rules nt = (nt,[(p,generateAction nt (funRule r) (mkFlip b m)) | r0 <- rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True,revSepListRule r0) else (False,r0), let (p,m) = generatePatterns cf r]) where revs = reversibleCats cf mkFlip doit xs = case xs of a:b:rest | doit -> b:a:rest _ -> xs -- Generates a string containing the semantic action. -- An action can for example be: Sum $1 $2, that is, construct an AST -- with the constructor Sum applied to the two metavariables $1 and $2. generateAction :: NonTerminal -> Fun -> [MetaVar] -> Action generateAction nt f ms = (if isCoercion f then "" else f') +++ mkTuple ms where f' = case f of -- ocaml cons is somehow not a standard infix oper, right? "(:[])" -> "(fun x -> [x])" "(:)" -> "(fun (x,xs) -> x::xs)" _ -> f generatePatterns :: CF -> Rule -> (Pattern,[MetaVar]) generatePatterns cf r = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> nonterminal c Right s -> terminal cf s metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 ::Int ..] its] revIf c m = if (not (isConsFun (funRule r)) && elem c revs) then ("(List.rev " ++ m ++ ")") else m -- no reversal in the left-recursive Cons rule itself revs = reversibleCats cf specialRules :: CF -> String specialRules cf = unlines $ map aux (literals cf) where aux cat = case cat of "Ident" -> "ident : TOK_Ident { Ident $1 };" "String" -> "string : TOK_String { $1 };" "Integer" -> "int : TOK_Integer { $1 };" "Double" -> "float : TOK_Double { $1 };" "Char" -> "char : TOK_Char { $1 };" own -> (fixType own) ++ " : TOK_" ++ own ++ " { " ++ own ++ " ("++ posn ++ "$1)};" -- PCC: take "own" as type name? (manual says newtype) where -- ignore position categories for now posn = "" -- if isPositionCat cf cat then "mkPosToken " else "" BNFC-2.6.0.3/src/formats/ocaml/CFtoOCamlTemplate.hs0000644000000000000000000000457212100475635017725 0ustar0000000000000000{- BNF Converter: Template Generator Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- based on BNFC Haskell backend module CFtoOCamlTemplate ( cf2Template ) where import CF import Data.Char import Data.List (delete) import Utils((+++)) import OCamlUtil type ModuleName = String type Constructor = String cf2Template :: ModuleName -> ModuleName -> CF -> String cf2Template skelName absName cf = unlines [ "module "++ skelName ++ " = struct\n", "(* OCaml module generated by the BNF converter *)\n", "open " ++ absName ++ "\n", "type result = string\n", "let failure x = failwith \"Undefined case.\" (* x discarded *)\n", unlines $ mutualDefs $ map (\(s,xs) -> case_fun s (toArgs xs)) $ specialData cf ++ cf2data cf, "end" ] where toArgs [] = [] toArgs ((cons,args):xs) = (cons ++ " " ++ (mkTuple $ names (map (checkRes . var) args) (0 :: Int))) : toArgs xs names :: [String] -> Int -> [String] names [] _ = [] names (x:xs) n | elem x xs = (x ++ show n) : names xs (n+1) | otherwise = x : names xs n var ('[':xs) = var (init xs) ++ "s" var "Ident" = "id" var "Integer" = "n" var "String" = "str" var "Char" = "c" var "Double" = "d" var xs = map toLower xs checkRes s | elem s reservedOCaml = s ++ "'" | otherwise = s case_fun :: Cat -> [Constructor] -> String case_fun cat xs = unlines $ ["trans" ++ cat ++ " (x : " ++ fixType cat ++ ") : result = match x with", unlines $ insertBar $ map (\s -> s ++ " -> " ++ "failure x") xs] BNFC-2.6.0.3/src/formats/ocaml/OCamlTop.hs0000644000000000000000000001642612100475635016141 0ustar0000000000000000{- BNF Converter: OCaml main file Copyright (C) 2005 Author: Kristofer Johannisson 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -- based on BNFC Haskell backend module OCamlTop (makeOCaml) where import CF import CFtoOCamlYacc import CFtoOCamlLex import CFtoLatex import CFtoOCamlAbs import CFtoOCamlTemplate import CFtoOCamlPrinter import CFtoOCamlShow import CFtoOCamlTest import CFtoXML import Utils import Options import Data.Char import Data.Maybe (fromMaybe,maybe) import System.Exit (exitFailure) import Control.Monad(when) -- naming conventions noLang :: Options -> String -> String noLang _ name = name withLang :: Options -> String -> String withLang opts name = name ++ lang opts mkMod :: (Options -> String -> String) -> String -> Options -> String mkMod addLang name opts = pref ++ if inDir opts then lang opts ++ "." ++ name else addLang opts name where pref = maybe "" (++".") (inPackage opts) mkFile :: (Options -> String -> String) -> String -> String -> Options -> FilePath mkFile addLang name ext opts = pref ++ if inDir opts then lang opts ++ [pathSep] ++ name ++ ext' else addLang opts name ++ if null ext then "" else ext' where pref = maybe "" (\p->pkgToDir p++[pathSep]) (inPackage opts) ext' = if null ext then "" else "." ++ ext absFile, absFileM, ocamllexFile, ocamllexFileM, dviFile, ocamlyaccFile, ocamlyaccFileM, latexFile, utilFile, utilFileM, templateFile, templateFileM, printerFile, printerFileM, psFile, tFile, tFileM :: Options -> String absFile = mkFile withLang "Abs" "ml" absFileM = mkMod withLang "Abs" ocamllexFile = mkFile withLang "Lex" "mll" ocamllexFileM = mkMod withLang "Lex" ocamlyaccFile = mkFile withLang "Par" "mly" ocamlyaccFileM = mkMod withLang "Par" latexFile = mkFile withLang "Doc" "tex" templateFile = mkFile withLang "Skel" "ml" templateFileM = mkMod withLang "Skel" printerFile = mkFile withLang "Print" "ml" printerFileM = mkMod withLang "Print" showFile = mkFile withLang "Show" "ml" showFileM = mkMod withLang "Show" dviFile = mkFile withLang "Doc" "dvi" psFile = mkFile withLang "Doc" "ps" tFile = mkFile withLang "Test" "ml" tFileM = mkMod withLang "Test" utilFile = mkFile noLang "BNFC_Util" "ml" utilFileM = mkMod noLang "BNFC_Util" xmlFileM = mkMod withLang "XML" type Options = SharedOptions -- FIXME: we probably don't need all these arguments makeOCaml :: Options -> CF -> IO () makeOCaml opts cf = do let absMod = absFileM opts lexMod = ocamllexFileM opts parMod = ocamlyaccFileM opts prMod = printerFileM opts showMod = showFileM opts -- layMod = layoutFileM opts utilMod = utilFileM opts do let dir = codeDir opts when (not (null dir)) $ do putStrLn $ "Creating directory " ++ dir prepareDir dir writeFileRep (absFile opts) $ cf2Abstract absMod cf writeFileRep (ocamllexFile opts) $ cf2ocamllex lexMod parMod cf writeFileRep (ocamlyaccFile opts) $ cf2ocamlyacc parMod absMod lexMod cf writeFileRep (latexFile opts) $ cfToLatex (lang opts) cf writeFileRep (templateFile opts) $ cf2Template (templateFileM opts) absMod cf writeFileRep (printerFile opts) $ cf2Printer prMod absMod cf writeFileRep (showFile opts) $ cf2show showMod absMod cf writeFileRep (tFile opts) $ ocamlTestfile absMod lexMod parMod prMod showMod cf writeFileRep (utilFile opts) $ utilM when (make opts) $ writeFileRep "Makefile" $ makefile opts case xml opts of 2 -> makeXML (lang opts) True cf 1 -> makeXML (lang opts) False cf _ -> return () pkgToDir :: String -> FilePath pkgToDir s = replace '.' pathSep s codeDir :: Options -> FilePath codeDir opts = let pref = maybe "" pkgToDir (inPackage opts) dir = if inDir opts then lang opts else "" sep = if null pref || null dir then "" else [pathSep] in pref ++ sep ++ dir makefile :: Options -> String makefile opts = makeA where dir = let d = codeDir opts in if null d then "" else d ++ [pathSep] cd c = if null dir then c else "(cd " ++ dir ++ "; " ++ c ++ ")" makeA = unlines [ "all:", "\tocamlyacc " ++ ocamlyaccFile opts, "\tocamllex " ++ ocamllexFile opts, "\t" ++ cd ("latex " ++ basename (latexFile opts) ++ "; " ++ "dvips " ++ basename (dviFile opts) ++ " -o " ++ basename (psFile opts)), "\tocamlc -o " ++ mkFile withLang "Test" "" opts +++ utilFile opts +++ absFile opts +++ templateFile opts +++ showFile opts +++ printerFile opts +++ mkFile withLang "Par" "mli" opts +++ mkFile withLang "Par" "ml" opts +++ mkFile withLang "Lex" "ml" opts +++ tFile opts, "", "clean:", "\t-rm -f " ++ unwords (map (dir++) [ "*.log", "*.aux", "*.cmi", "*.cmo", "*.o", "*.dvi" ]), "\t-rm -f " ++ psFile opts, "", "distclean: clean", "\t-rm -f " ++ unwords [ mkFile withLang "Doc" "*" opts, mkFile withLang "Lex" "*" opts, mkFile withLang "Par" "*" opts, mkFile withLang "Layout" "*" opts, mkFile withLang "Skel" "*" opts, mkFile withLang "Print" "*" opts, mkFile withLang "Show" "*" opts, mkFile withLang "Test" "*" opts, mkFile withLang "Abs" "*" opts, mkFile withLang "Test" "" opts, utilFile opts, "Makefile*" ] ] utilM :: String utilM = unlines ["(* automatically generated by BNFC *)", "", "open Lexing", "", "(* this should really be in the parser, but ocamlyacc won't put it in the .mli *)", "exception Parse_error of Lexing.position * Lexing.position" ] BNFC-2.6.0.3/src/formats/xml/0000755000000000000000000000000012100475634013622 5ustar0000000000000000BNFC-2.6.0.3/src/formats/xml/CFtoXML.hs0000644000000000000000000001632712100475634015403 0ustar0000000000000000{- BNF Converter: XML generator Copyright (C) 2004 Author: Aarne Ranta 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module CFtoXML ---- (cf2DTD, cf2XML) where import CF import Utils import CFtoTemplate import Data.List (intersperse, nub) import Data.Char(toLower) type Coding = Bool ---- change to at least three values makeXML :: FilePath -> Coding -> CF -> IO () makeXML name typ cf = do writeFileRep (name ++ ".dtd") $ cf2DTD typ name cf let absmod = "XML" ++ name writeFileRep (absmod ++ ".hs") $ cf2XMLPrinter typ name absmod cf -- derive a DTD from a BNF grammar. AR 21/8/2004 cf2DTD :: Coding -> String -> CF -> String cf2DTD typ name cf = unlines [ tag ("?xml version=\"1.0\" standalone=\"yes\"?"), "" ] tag s = "<" ++ s ++ ">" element t ts = tag ("!ELEMENT " ++ t ++ " " ++ alts ts) attlist t a = tag ("!ATTLIST " ++ t ++ " " ++ a ++ " CDATA #REQUIRED") elemAtt t a ts = element t ts ++++ attlist t a elemt t = elemAtt t "name" elemc cat fs = unlines $ element cat (map snd fs) : [element f [] | (f,_) <- fs] elemEmp t = elemAtt t "value" [] alts ts = if null ts then "EMPTY" else parenth (unwords (intersperse "|" ts)) -- choose between these two encodings: elemData b = if b then elemDataConstr else elemDataNotyp efunDef b = if b then efunDefConstr else efunDefNotyp endtagDef b = if b then endtagDefConstr else endtagDefNotyp -- coding 0: ---- not finished -- to show both types and constructors as tags; -- lengthy, but validation guarantees type correctness -- flag -xmlt elemDataConstrs cf (cat,fcs) = elemc cat ([(f,rhsCat cf (f:cs)) | (f,cs) <- fcs]) efunDefConstrs = "elemFun i t x = [replicate (i+i) ' ' ++ tag t ++ \" \" ++ etag x]" endtagDefConstrs = "endtag f c = tag (\"/\" ++ c)" -- coding 1: -- to show constructors as empty tags; -- shorter than 0, but validation still guarantees type correctness -- flag -xmlt elemDataConstr cf (cat,fcs) = elemc cat ([(f,rhsCat cf (f:cs)) | (f,cs) <- fcs]) efunDefConstr = "elemFun i t x = [replicate (i+i) ' ' ++ tag t ++ \" \" ++ etag x]" endtagDefConstr = "endtag f c = tag (\"/\" ++ c)" -- coding 2: -- constructors as tags, no types. -- clumsy DTD, but nice trees. Validation guarantees type correctness -- flag -xml elemDataNotyp cf (cat,fcs) = unlines [element f [rhsCatNot cf cs] | (f,cs) <- fcs] efunDefNotyp = "elemFun i t x = [replicate (i+i) ' ' ++ tag x]" endtagDefNotyp = "endtag f c = tag (\"/\" ++ f)" -- to show constructors as attributes; -- nice, but validation does not guarantee type correctness. -- Therefore rejected. -- elemDataAttr cf (cat,fcs) = elemt cat (nub [rhsCat cf cs | (_,cs) <- fcs]) -- efunDefAttr = "elemFun i t x = [replicate (i+i) ' ' ++ tag (t ++ \" name = \" ++ x)]" rhsCat cf cs = parenth (concat (intersperse ", " (map (symbCat cf) cs))) rhsCatNot cf cs = if null cs then "EMPTY" else concat (intersperse ", " (map (symbCatNot cf) cs)) symbCat cf c | isList c = normCatOfList c ++ if isEmptyListCat cf c then "*" else "+" | otherwise = c symbCatNot cf c | isList c = funs (normCatOfList c) ++ if isEmptyListCat cf c then "*" else "+" | otherwise = funs c where funs k = case lookup k (cf2data cf) of Just [] -> "EMPTY" Just fcs -> parenth $ unwords $ intersperse "|" $ map fst fcs _ -> parenth k ---- parenth s = "(" ++ s ++ ")" -- derive an XML printer from a BNF grammar cf2XMLPrinter :: Bool -> String -> String -> CF -> String cf2XMLPrinter typ name absMod cf = unlines [ prologue typ name absMod, integerRule cf, doubleRule cf, stringRule cf, if hasIdent cf then identRule cf else "", unlines [ownPrintRule cf own | (own,_) <- tokenPragmas cf], rules cf ] prologue :: Bool -> String -> String -> String prologue b name absMod = unlines [ "module " ++ absMod +++ "where\n", "-- pretty-printer generated by the BNF converter\n", "import Abs" ++ name, "import Data.Char", "", "-- the top-level printing method", "printXML :: XPrint a => a -> String", "printXML = render . prt 0", "", "render = unlines", "", "-- the printer class does the job", "class XPrint a where", " prt :: Int -> a -> [String]", " prtList :: Int -> [a] -> [String]", " prtList i = concat . map (prt i)", "", "instance XPrint a => XPrint [a] where", " prt = prtList", "", "tag t = \"<\" ++ t ++ \">\"", "etag t = \"<\" ++ t ++ \"/>\"", "elemTok i t x = [replicate (i+i) ' ' ++ tag (t ++ \" value = \" ++ show x ++ \" /\")]", "elemTokS i t x = elemTok i t (show x)", efunDef b, endtagDef b, "" ] integerRule cf = showsPrintRule cf "Integer" doubleRule cf = showsPrintRule cf "Double" stringRule cf = showsPrintRule cf "Char" ++++ " prtList i xs = elemTok i \"String\" xs" showsPrintRule cf t = unlines $ [ "instance XPrint " ++ t ++ " where", " prt i x = elemTokS i" +++ "\"" ++ t ++ "\"" +++ "x" ] identRule cf = ownPrintRule cf "Ident" ownPrintRule cf t = unlines $ [ "instance XPrint " ++ t ++ " where", " prt i (" ++ t ++ posn ++ ") = elemTok i" +++ "\"" ++ t ++ "\"" +++ "x" ] where posn = if isPositionCat cf t then " (_,x)" else " x" rules :: CF -> String rules cf = unlines $ map (\(s,xs) -> case_fun s (map toArgs xs)) $ cf2data cf where toArgs (cons,args) = ((cons, names (map (checkRes . var) args) (0 :: Int)), ruleOf cons) names [] _ = [] names (x:xs) n | elem x xs = (x ++ show n) : names xs (n+1) | otherwise = x : names xs n var ('[':xs) = var (init xs) ++ "s" var "Ident" = "id" var "Integer" = "n" var "String" = "str" var "Char" = "c" var "Double" = "d" var xs = map toLower xs checkRes s | elem s reservedHaskell = s ++ "'" | otherwise = s reservedHaskell = ["case","class","data","default","deriving","do","else","if", "import","in","infix","infixl","infixr","instance","let","module", "newtype","of","then","type","where","as","qualified","hiding"] ruleOf s = maybe undefined id $ lookupRule s (rulesOfCF cf) --- case_fun :: Cat -> [(Constructor,Rule)] -> String case_fun cat xs = unlines [ "instance XPrint" +++ cat +++ "where", " prt i" +++ "e = case e of", unlines $ map (\ ((c,xx),r) -> " " ++ c +++ unwords xx +++ "-> concat $ " +++ "elemFun i \"" ++ cat ++ "\" \"" ++ c ++ "\"" +++ unwords [": prt (i+1)" +++ x | x <- xx] +++ ":" +++ "[[replicate (i+i) ' ' ++ endtag \"" ++ c ++ "\" \"" ++ cat ++ "\"]]" ) xs ] BNFC-2.6.0.3/src/Data/0000755000000000000000000000000012100475630012214 5ustar0000000000000000BNFC-2.6.0.3/src/Data/Pair.hs0000644000000000000000000000044012100475630013441 0ustar0000000000000000module Data.Pair where import Control.Applicative infixl 2 :/: data Pair a = (:/:) {leftOf :: a, rightOf :: a} deriving (Show) instance Functor Pair where fmap f (a :/: b) = f a :/: f b instance Applicative Pair where pure a = a :/: a (f :/: g) <*> (a :/: b) = f a :/: g b BNFC-2.6.0.3/runtime/0000755000000000000000000000000012100475630012237 5ustar0000000000000000BNFC-2.6.0.3/runtime/Algebra/0000755000000000000000000000000012100475630013574 5ustar0000000000000000BNFC-2.6.0.3/runtime/Algebra/RingUtils.hs0000644000000000000000000000301512100475630016047 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Algebra.RingUtils ( module Prelude , AbelianGroup(..) , AbelianGroupZ(..) , Ring(..) , RingP(..) , Pair(..), select, onlyLeft, onlyRight , O(..) , sum , mulDefault , module Data.Pair ) where import qualified Prelude as P import Prelude hiding ( (+), (*), splitAt, sum ) import Control.Applicative import Data.Pair class AbelianGroup a where zero :: a (+) :: a -> a -> a instance AbelianGroup Int where zero = 0 (+) = (P.+) class AbelianGroup a => AbelianGroupZ a where isZero :: a -> Bool instance AbelianGroupZ Int where isZero x = x == 0 class AbelianGroupZ a => Ring a where (*) :: a -> a -> a class (AbelianGroupZ a) => RingP a where mul :: Bool -> a -> a -> Pair a -- mul _ x y = pure $ x * y mulDefault x y = leftOf (mul False x y) onlyLeft x = x :/: [] onlyRight x = [] :/: x select p = if p then onlyRight else onlyLeft newtype O f g a = O {fromO :: f (g a)} deriving (AbelianGroup, AbelianGroupZ, Show) instance (Functor f,Functor g) => Functor (O f g) where fmap f (O x) = O (fmap (fmap f) x) instance AbelianGroup a => AbelianGroup (Pair a) where zero = (zero:/:zero) (a:/:b) + (x:/:y) = (a+x) :/: (b+y) instance AbelianGroupZ a => AbelianGroupZ (Pair a) where isZero (a:/:b) = isZero a && isZero b instance Ring Int where (*) = (P.*) infixl 7 * infixl 6 + sum :: AbelianGroup a => [a] -> a sum = foldr (+) zero instance AbelianGroup Bool where zero = False (+) = (||)BNFC-2.6.0.3/runtime/Parsing/0000755000000000000000000000000012100475630013642 5ustar0000000000000000BNFC-2.6.0.3/runtime/Parsing/TestProgram.hs0000644000000000000000000000456012100475630016452 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} module Parsing.TestProgram where import System.IO ( stdin, hGetContents ) import System.Environment ( getArgs, getProgName ) import GHC.Exts import Control.Monad import Control.Applicative (pure) import Parsing.Chart hiding (fingerprint,mkTree) import Data.Matrix.Quad import Data.Pair import Algebra.RingUtils type Verbosity = Int putStrV :: Verbosity -> String -> IO () putStrV v s = if v > 1 then putStrLn s else return () mainTest :: forall category token. (RingP [(category,Any)], Eq category) => ((category,Any) -> String) -> (Bool -> token -> Pair [(category,Any)]) -> (String -> [token]) -> (token -> (Int,Int)) -> (category -> String) -> (category -> [category]) -> IO () mainTest showAst cnfToksToCat myLLexer getTokPos describe follows = do args <- getArgs case args of [] -> hGetContents stdin >>= run 2 "-s":fs -> mapM_ (runFile 0) fs fs -> mapM_ (runFile 2) fs where neighbors a b = b `elem` follows a showResults :: [(category,Any)] -> IO () showResults x = do putStrLn $ show (length x) ++ " results" forM_ x $ \(cat,ast) -> do putStrLn $ describe cat putStrLn $ showAst (cat,ast) runFile v f = putStrLn f >> readFile f >>= run v run v s = do case rs of [(_,x,_)] -> showResults x _ -> do let errs = pairs rs best = minimum $ map quality errs mapM_ (putStrLn . showErr ts) $ filter (\x -> quality x == best) errs writeFile "cnf.xpm" (genXPM $ fingerprint chart) where ts = myLLexer s chart = mkTree $ zipWith cnfToksToCat (cycle [False,True]) ts rs = results chart showTokPos :: (Int,Int) -> String showTokPos (l,c) = show l ++ "," ++ show (c-1) showPos :: [token] -> Int -> String showPos ts x = showTokPos (getTokPos $ ts !! x) showErr ts ((_,x',p),(_,y',_)) = showPos ts p ++ ": cannot combine " ++ showBestCat x' ++ " with " ++ showBestCat y' quality (a@(_,x',p),b@(_,y',_)) = (or [ neighbors x y | x <- map fst x', y <- map fst y'], (resSz a) Prelude.+ (resSz b)) showBestCat ((x,_):_) = describe x pairs (x:y:xs) = (x,y):pairs (y:xs) pairs _ = [] resSz (i,_,j) = j-i BNFC-2.6.0.3/runtime/Parsing/Chart.hs0000644000000000000000000000342412100475630015242 0ustar0000000000000000{-# LANGUAGE NoMonomorphismRestriction, TypeSynonymInstances, FlexibleInstances #-} module Parsing.Chart where import Data.Array import Data.Maybe import Prelude () import Data.Traversable (sequenceA) import Control.Applicative ((<$>),(<*>),pure) import Control.Monad(join) import Data.List (splitAt) import Algebra.RingUtils import qualified Data.Matrix.Quad as Q import Data.Matrix.Class fingerprint = Q.fingerprint {- mkTreeHelp alt s = sweeps (map single s) where sweeps [] = error "can't parse the empty string, sorry" sweeps [p] = p sweeps ps = sweeps (pairs ps alts) pairs [] _ = [] pairs [p] _ = [p] pairs (p:q:ps) (b:bs) = (merging b p q) : pairs ps bs alts = cycle alt -} -- mkTree2 :: (AbelianGroupZ (c a), RingP a, IsChart c) => Bool -> [Pair a] -> c a mkTree2 :: RingP a => Bool -> [Pair a] -> Q.Q a mkTree2 p [] = error "can't parse the empty string, sorry" mkTree2 p [x] = Q.square2 x mkTree2 p [x,y] = Q.square3 p x y mkTree2 p leaves = Q.mergein p (mkTree2 False xs) y (mkTree2 True zs) where (xs,y:zs) = splitAt n2 leaves n2 = length leaves `div` 2 -- mkTree :: (RingP a, IsChart c) => [Pair a] -> c a mkTree = mkTree2 False -- mkTreeHelp [False,True] mkTree' = mkTree2 True -- mkTreeHelp [True,False] type Set a = [a] -- Sets form an abelian group instance AbelianGroup (Set a) where zero = [] (+) = (++) instance AbelianGroupZ (Set a) where isZero = null type MT2 a = Q.Q a genXPM xs@(h:_) = unlines $ ["! XPM2", -- show width ++ " " ++ show height ++ " 4 1", "X c cyan", "< c blue", "> c red", " c black" ] ++ xs where width = length h height = length xs root = Q.root mergein a c b = Q.mergein a c b single x = Q.single x BNFC-2.6.0.3/runtime/Data/0000755000000000000000000000000012100475630013110 5ustar0000000000000000BNFC-2.6.0.3/runtime/Data/Matrix/0000755000000000000000000000000012100475630014354 5ustar0000000000000000BNFC-2.6.0.3/runtime/Data/Matrix/Quad.hs0000644000000000000000000002434712100475630015614 0ustar0000000000000000{-# LANGUAGE GADTs, DataKinds, ScopedTypeVariables, KindSignatures #-} module Data.Matrix.Quad where import Prelude () import Data.List (splitAt,intercalate) import Control.Applicative import Algebra.RingUtils hiding (O) import Data.Traversable import Data.Foldable data Shape = Bin Shape Shape | Leaf data Shape' :: Shape -> * where Bin' :: !Int -> Shape' s -> Shape' s' -> Shape' (Bin s s') Leaf' :: Shape' Leaf data SomeShape where S :: Shape' s -> SomeShape data Mat :: Shape -> Shape -> * -> * where Quad :: !(Mat x1 y1 a) -> !(Mat x2 y1 a) -> !(Mat x1 y2 a) -> !(Mat x2 y2 a) -> Mat (Bin x1 x2) (Bin y1 y2) a Zero :: Mat x y a One :: !a -> Mat Leaf Leaf a Row :: Mat x1 Leaf a -> Mat x2 Leaf a -> Mat (Bin x1 x2) Leaf a Col :: Mat Leaf y1 a -> Mat Leaf y2 a -> Mat Leaf (Bin y1 y2) a data Vec :: Shape -> * -> * where Z :: Vec s a O :: a -> Vec Leaf a (:!) :: Vec s a -> Vec s' a -> Vec (Bin s s') a row Zero Zero = Zero row x y = Row x y col :: Mat Leaf y1 a -> Mat Leaf y2 a -> Mat Leaf (Bin y1 y2) a col Zero Zero = Zero col x y = Col x y quad Zero Zero Zero Zero = Zero quad a b c d = Quad a b c d one :: AbelianGroupZ a => a -> Mat Leaf Leaf a one x | isZero x = Zero | otherwise = One x (.+.) :: AbelianGroupZ a => Mat x y a -> Mat x y a -> Mat x y a Zero .+. x = x x .+. Zero = x Quad a b c d .+. Quad a' b' c' d' = quad (a .+. a') (b .+. b') (c .+. c') (d .+. d') One x .+. One x' = one (x + x') Row x y .+. Row x' y' = row (x .+. x') (y .+. y') Col x y .+. Col x' y' = col (x .+. x') (y .+. y') instance AbelianGroupZ a => AbelianGroup (Mat x y a) where (+) = (.+.) zero = Zero mult :: RingP a => Bool -> Mat x y a -> Mat z x a -> Mat z y (Pair a) mult p a b = a & b where infixl 7 & (&) :: RingP a => Mat x y a -> Mat z x a -> Mat z y (Pair a) Zero & x = Zero x & Zero = Zero One x & One x' = one (mul p x x') One x & Row a b = row (One x & a) (One x & b) Col a b & One x = col (a & One x) (b & One x) Row a b & Col a' b' = a & a' + b & b' Col a b & Row a' b' = quad (a & a') (a & b') (b & a') (b & b') Row a b & Quad a' b' c' d' = row (a & a' + b & c') (a & b' + b & d') Quad a b c d & Col a' c' = col (a & a' + b & c') (c & a' + d & c') Quad a b c d & Quad a' b' c' d' = quad (a & a' + b & c') (a & b' + b & d') (c & a' + d & c') (c & b' + d & d') x & y = error $ "mult:" ++ intercalate "; " [showR x,showR y] -- a variant of traverse. The constraint prevents to just use traverse. trav :: AbelianGroupZ a => Mat y x (Pair a) -> Pair (Mat y x a) trav Zero = pure Zero trav (Quad a b c d) = quad <$> trav a <*> trav b <*> trav c <*> trav d trav (One x) = one <$> x trav (Col a b) = col <$> trav a <*> trav b trav (Row a b) = row <$> trav a <*> trav b q0 :: Mat (Bin x x') (Bin y y') a q0 = Quad Zero Zero Zero Zero closeDisjointP :: RingP a => Bool -> Mat x x a -> Mat y x (Pair a) -> Mat y y a -> Pair (Mat y x a) closeDisjointP p l c r = close l c r where close :: RingP a => Mat x x a -> Mat y x (Pair a) -> Mat y y a -> Pair (Mat y x a) close l Zero r = Zero :/: Zero close Zero x Zero = trav x -- if x = One x', we are in this case close (Quad a11 a12 Zero a22) (Quad c11 c12 c21 c22) (Quad b11 b12 Zero b22) = quad <$> x11 <*> x12 <*> x21 <*> x22 where x21 = close a22 c21 b11 x11 = close a11 (a12 & rightOf x21 + c11) b11 x22 = close a22 (leftOf x21 & b12 + c22) b22 x12 = close a11 (a12 & rightOf x22 + leftOf x11 & b12 + c12) b22 close Zero (Quad c11 c12 c21 c22) (Quad b11 b12 Zero b22) = close q0 (Quad c11 c12 c21 c22) (Quad b11 b12 Zero b22) close (Quad a11 a12 Zero a22) (Quad c11 c12 c21 c22) Zero = close (Quad a11 a12 Zero a22) (Quad c11 c12 c21 c22) q0 close (Quad a11 a12 Zero a22) (Col c1 c2) (Zero) = col <$> x1 <*> x2 where x2 = close a22 c2 Zero x1 = close a11 (mult p a12 (rightOf x2) + c1) Zero close Zero (Row c1 c2) (Quad b11 b12 Zero b22) = row <$> x1 <*> x2 where x1 = close Zero c1 b11 x2 = close Zero (mult p (leftOf x1) b12 + c2) b22 close a c b = error $ "closeDisjointP:" ++ intercalate "; " [showR a,showR c,showR b] (&) :: RingP a => Mat x y a -> Mat z x a -> Mat z y (Pair a) (&) = mult p showR :: Mat x y a -> String showR Zero = "0" showR (One _) = "1" showR (Row a b) = "("++showR a++"-"++showR b++")" showR (Col a b) = "("++showR a++"|"++showR b++")" showR (Quad a b c d) = "#("++ intercalate "," [showR a,showR b,showR c,showR d]++")" bin' :: Shape' s -> Shape' s' -> Shape' (Bin s s') bin' s s' = Bin' (sz' s + sz' s') s s' mkShape :: Int -> SomeShape mkShape 1 = S (bin' Leaf' Leaf') mkShape 2 = S (bin' (bin' Leaf' Leaf') Leaf') mkShape n = case (mkShape n'1, mkShape n'2) of (S x, S y) -> S (bin' x y) where n'1 = n `div` 2 n'2 = n - n'1 - 1 mkSing :: AbelianGroupZ a => Shape' x -> Shape' y -> a -> Mat x y a mkSing (Bin' _ x1 x2) (Bin' _ y1 y2) a = quad Zero Zero (mkSing x1 y2 a) Zero mkSing Leaf' Leaf' a = one a mkSing Leaf' (Bin' _ y1 y2) a = col Zero (mkSing Leaf' y2 a) mkSing (Bin' _ x1 x2) Leaf' a = row (mkSing x1 Leaf' a) Zero data SomeTri a where T :: Shape' s -> Pair (Mat s s a) -> SomeTri a type Q a = SomeTri a mkUpDiag :: AbelianGroupZ a => [a] -> Shape' s -> Mat s s a mkUpDiag [] Leaf' = Zero mkUpDiag xs (Bin' _ s s') = Quad (mkUpDiag a s) (mkSing s' s c) Zero (mkUpDiag b s') where (a,c:b) = splitAt (sz' s - 1) xs close :: RingP a => Bool -> Mat s s (Pair a) -> Pair (Mat s s a) close p Zero = zero close p (One x) = one <$> x close p (Quad a11 a12 Zero a22) = quad' x11 (closeDisjointP p (leftOf x11) a12 (rightOf x22)) zero x22 where x11 = close (not p) a11 x22 = close (not p) a22 mkTree :: RingP a => [Pair a] -> SomeTri a mkTree xs = case mkShape (length xs) of S s -> T s (close True $ mkUpDiag xs s) quad' a b c d = quad <$> a <*> b <*> c <*> d mergein :: RingP a => Bool -> SomeTri a -> Pair a -> SomeTri a -> SomeTri a mergein p (T y a) c (T x b) = T (bin' y x) (quad' a (closeDisjointP p (leftOf a) c' (rightOf b)) zero b) where c' = mkSing x y c -- | A variant of zipWith on vectors zw :: (AbelianGroup a, AbelianGroup b) => (a -> b -> c) -> Vec y a -> Vec y b -> Vec y c zw f Z Z = Z zw f Z (a :! b) = zw f (Z :! Z) (a :! b) zw f (a :! b) Z = zw f (a :! b) (Z :! Z) zw f Z (O x) = O $ f zero x zw f (O x) Z = O $ f x zero zw f (O x) (O y) = O (f x y) zw f (a :! b) (a' :! b') = zw f a a' :! zw f b b' -- | Lookup in a vector lk :: AbelianGroup a => Int -> Shape' x -> Vec x a -> a lk n _ Z = zero lk 0 Leaf' (O x) = x lk i (Bin' _ s s') (x :! x') | i < sz' s = lk i s x | otherwise = lk (i - sz' s) s' x' -- | Linearize a matrix lin' :: AbelianGroup a => Mat x y a -> Vec y (Vec x a) lin' Zero = Z lin' (One a) = O (O a) lin' (Row a b) = zw (:!) (lin' a) (lin' b) lin' (Col a b) = lin' a :! lin' b lin' (Quad a b c d) = zw (:!) (lin' a) (lin' b) :!zw (:!) (lin' c) (lin' d) -- | Contents of a vector contents :: Shape' x -> Vec x a -> [(Int,a)] contents s Z = [] contents s (O a) = [(0,a)] contents (Bin' _ s s') (xs :! xs') = contents s xs ++ map (first (+sz' s)) (contents s' xs') first f (a,b) = (f a,b) second f (a,b) = (a,f b) instance AbelianGroup a => AbelianGroup (Vec x a) where zero = Z (+) = zw (+) data Path :: Shape -> * where Here :: Path Leaf Low :: Path s -> Path (Bin s s') High :: Path s -> Path (Bin s' s) (<||>) :: Maybe (a,Path x) -> Maybe (a,Path x') -> Maybe (a,Path (Bin x x')) x <||> y = (second High <$> y) <|> (second Low <$> x) -- | What is, and where is the rightmost non-zero element on a given -- line of the matrix? rightmostOnLine :: Path y -> Mat x y a -> Maybe (a,Path x) rightmostOnLine _ Zero = Nothing rightmostOnLine Here (One x) = Just (x,Here) rightmostOnLine Here (Row a b) = rightmostOnLine Here a <||> rightmostOnLine Here b rightmostOnLine (Low p) (Col a b) = rightmostOnLine p a rightmostOnLine (High p) (Col a b) = rightmostOnLine p b rightmostOnLine (Low p) (Quad a b _ _) = rightmostOnLine p a <||> rightmostOnLine p b rightmostOnLine (High p) (Quad _ _ a b) = rightmostOnLine p a <||> rightmostOnLine p b -- | Is this the rightmost path? isRightmost :: Path x -> Bool isRightmost (Low _) = False isRightmost (Here) = True isRightmost (High x) = isRightmost x results' :: AbelianGroup a => Mat y y a -> Path y -> [(Path y, a, Path y)] results' m y | isRightmost y = [] | otherwise = (y,a,x) : results' m x where Just (a,x) = rightmostOnLine y m results :: AbelianGroupZ a => SomeTri a -> [(Int, a, Int)] results (T s (m :/: m')) = [(fromPath s x,a,fromPath s y) | (x,a,y) <- results' (m+m') (leftMost s)] leftMost :: Shape' s -> Path s leftMost Leaf' = Here leftMost (Bin' _ s _) = Low $ leftMost s fromPath :: Shape' y -> Path y -> Int fromPath _ Here = 0 fromPath (Bin' _ s s') (Low x) = fromPath s x fromPath (Bin' _ s s') (High x) = sz' s + fromPath s' x root' :: AbelianGroup a => Mat x y a -> a root' Zero = zero root' (One x) = x root' (Quad _ a _ _) = root' a root' (Col a _) = root' a root' (Row _ a) = root' a root (T _ (m :/: m')) = root' m + root' m' single x = T Leaf' (one <$> x) square2 x = T (bin' Leaf' Leaf') $ quad' zero (one <$> x) zero zero square3 p x y = T (bin' (bin' Leaf' Leaf') (Leaf')) (quad' (quad' zero (one <$> x) zero zero) (Col <$> (one <$> mul p (leftOf x) (rightOf y)) <*> (one <$> y)) zero zero) sz' :: Shape' s -> Int sz' Leaf' = 1 sz' (Bin' x l r) = x -- sz' l + sz' r (|+|) = zipWith (++) (-+-) = (++) -- TODO: reimplement using lin' lin :: AbelianGroup a => Shape' x -> Shape' y -> Mat x y a -> [[a]] lin x y Zero = replicate (sz' y) $ replicate (sz' x) zero lin _ _ (One x) = [[x]] lin (Bin' _ x x') (Bin' _ y y') (Quad a b c d) = (lin x y a |+| lin x' y b) -+- (lin x y' c |+| lin x' y' d) lin Leaf' (Bin' _ y y') (Col a b) = lin Leaf' y a -+- lin Leaf' y' b lin (Bin' _ x x') Leaf' (Row a b) = (lin x Leaf' a) |+| (lin x' Leaf' b) fingerprint (T s (m :/: m')) = zipWith (zipWith c) (lin s s m) (lin s s m') where c x y = case (isZero x,isZero y) of (True , True) -> ' ' (True , False) -> '>' (False , True) -> '<' (False , False) -> 'X' BNFC-2.6.0.3/runtime/Data/Matrix/Class.hs0000644000000000000000000000412712100475630015761 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} module Data.Matrix.Class where import Prelude () import Algebra.RingUtils import Control.Applicative hiding ((<|>)) fingerprint m = [[ if isZero (at i j m) then ' ' else 'X' | i <- [0..x-1] ] | j <- [0..y-1]] where x = countColumns m y = countRows m (f *** g) (x,y) = (f x,g y) data Dimension = XD | YD deriving (Eq,Show) quad a b c d = (a <|> b) <-> (c <|> d) nextDim XD = YD nextDim YD = XD type Extent = (Int,Int) ext XD (x,y) = x ext YD (x,y) = y glueExt XD (x1,y1) (x2,y2) = (x1+x2,y1) glueExt YD (x1,y1) (x2,y2) = (x1,y1+y2) splitExt XD k (x,y) = ((k,y),(x-k,y)) splitExt YD k (x,y) = ((x,k),(x,y-k)) class Matrix m where at :: AbelianGroupZ a => Int -> Int -> m a -> a extent :: m a -> Extent -- | Sigleton matrix singleton :: AbelianGroupZ a => a -> m a glue :: AbelianGroup a => Dimension -> m a -> m a -> m a split :: AbelianGroupZ a => Dimension -> Int -> m a -> (m a, m a) zeroMatrix :: AbelianGroup a => Int -> Int -> m a instance Matrix m => Matrix (O Pair m) where at i j (O (x :/: y)) = at i j x + at i j y extent (O (x :/: y)) = extent x -- union with y glue d (O p) (O q) = O $ glue d <$> p <*> q split d k (O (x :/: y)) = (O $ ax :/: ay, O $ bx :/: by) where (ax,bx) = split d k x (ay,by) = split d k y zeroMatrix x y = O $ pure (zeroMatrix x y) singleton x = O $ pure (singleton x) -- Attention: on both sides always! (<|>) :: (AbelianGroup a, Matrix m) => m a -> m a -> m a (<|>) = glue XD (<->) :: (AbelianGroup a, Matrix m) => m a -> m a -> m a (<->) = glue YD countColumns, countRows :: Matrix m => m a -> Int countColumns = ext XD . extent countRows = ext YD . extent chopLastColumn, chopFirstRow, chopFirstColumn, chopLastRow, lastColumn, firstRow :: (AbelianGroupZ a, Matrix m) => m a -> m a chopFirstRow = snd . split YD 1 chopFirstColumn = snd . split XD 1 chopLastColumn x = fst . split XD (countColumns x - 1) $ x firstRow = fst . split YD 1 lastColumn x = snd . split XD (countColumns x - 1) $ x chopLastRow x = fst . split YD (countRows x - 1) $ x