BNFC-2.8.1/0000755000000000000000000000000012654616013010424 5ustar0000000000000000BNFC-2.8.1/Setup.lhs0000644000000000000000000000015512654616013012235 0ustar0000000000000000#!/usr/bin/env runghc > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain BNFC-2.8.1/changelog0000644000000000000000000000256612654616013012307 0ustar00000000000000002.8 Grégoire Détrez May 2015 * Builds with ghc 7.10.1 * Add support for JFlex (java) * Add an option to generate files in an other directory * Add an experimental option that turns the AST into a parametrized functor (in Haskell only) * New pygment backend to generate syntax highlighters * Bug fixes 2.7.1 Grégoire Détrez October 2014 * Generated haskell code is now warning free * Removed unused terminal in happy * Correctly escape backslashes in symbols * Fix problem that was preventing custom tokens to work in OCaml if they conflict with the build-in Ident * BNFC build is also warning free (ghc 7.4.2) * Test programs return non-zerro exit code on parse error 2.7.0.0 Grégoire Détrez September 2014 * Add token support for Ocaml * New option parser * Adds an optional argument to change Makefile name * Add a --ghc option to derive Data, Typeable, Generic in Haskell * New online documentation (https://bnfc.readthedocs.org) * Derive ``Read`` for newtype decls in Haskell * New option to get the version number --version * Remove the F# backend * Remove the Java4 backend * New Applicative and Alternative instances to ``Err`` * Remove the coupling between building the parser and the pdf from latex * Improvement to the CNF Backend * Bug fixes #92, #21, #34, #33, #90, #30, #60 BNFC-2.8.1/TODO0000644000000000000000000000572512654616013011125 0ustar0000000000000000Build: - autoconf - verify Alex version. - tidy up Makefiles a bit - and the generated ones too. - Use "Makefile" everywhere. - follow UNIX conventions... Functionality: - Add Bool type. Bugs: - Strange unicode space. - Bison only supports 1 parser per input file. - Write some clear docs on the Java backend. - Java backend (and probably others) - Need to munge Java keywords like "abstract" "private" - Alfa.cf, C.cf fail to compile for this reason. - I think I fixed this, but it should be verified (peteg) - Add a message on how to run the test file (after a succesful compliation), e.g. : "to run the test, type : java JavaletteLight/Test " Compilers: - write a JavaCup script Bug Reports: -------------- > Fail: formats/java/CFtoJavaPrinter.hs:269: Non-exhaustive patterns in function> getCons on Prolog.cf Reason: No separator for a list. The same happens in C and C++. > In Skeleton.c the visit-functions for lists has the wrong variable for > visiting the > list elements. It says "visitNAME(LISTNAME->LISTNAME)" but it should be > "visitNAME(LISTNAME->NAME)". > > The parse tree printer and pretty printer writes a newline instead of "\n" > for > strings. -------------- Java backend If a terminal and non-terminal have the same name, there is a name clash in the generarted .java files. Solution: don't do this. See C.cf for an example. Alfa.cf doesn't work either. - "separator", etc. decs don't play nice. - the list stuff is emitted before the top-level non-terminal. - need to specify which non-terminal is the top-level one. - i.e. a "start with" line must be present. - BNFC now crashes if you don't specify an "entrypoint" pragma, or use more than one. Somewhere along the line of BNFC/jlex/jcup the BNFC comment-instruction (comment "/*" "*/" ;) seems to fail. A file containing only an opening of a comment manages to pass the parser without any trouble. -------------- Aarne, Java: to get "parse successful" is fast, but then it takes quite some time to pretty-print the parser gets confused with isolatin characters included in string literals Michael: http://www.cs.princeton.edu/~appel/modern/java/JLex/current/manual.html#SECTION2.2.14 -------------- Antti-Juhani Kaijanaho: - A token UIdent declaration (see report) causes a mysterious parse error at end of file / perhaps conflicts with predefined Ident? - If I use "\\/" in a production, Happy is unhappy (you use \/ as the Happy token) - You generate Alex 1.x source. Could you make it (optionally?) generate Alex 2.x source? Oh, and bnfc returns an exit code indicating success even when there is an error. -------------- Bjorn Bringert: - Specifying coercions etc. for non-existing categories should probably be an error. - Repeated identical rules should be an error. - Java CUP back end does not support multiple entrypoints. -------------- Software versions: ghc 5.04.x bison 1.875a flex 2.5.31 alex 2.0 happy 1.13 -------------- BNFC-2.8.1/BNFC.cabal0000644000000000000000000001414712654616013012127 0ustar0000000000000000Name: BNFC Version: 2.8.1 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-2 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 TODO changelog Source-repository head type: git location: https://github.com/BNFC/bnfc.git subdir: source 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, filepath, deepseq build-tools: alex, happy Main-is: Main.hs HS-source-dirs: src/ ghc-options: -W extensions: OverloadedStrings RecordWildCards FlexibleContexts Other-modules: -- generated by cabal Paths_BNFC, -- Generated by bnfc LexBNF, ParBNF, AbsBNF, PrintBNF, ErrM, -- BNFC core BNFC.Utils, BNFC.CF, BNFC.ToCNFCore, BNFC.MultiView, BNFC.TypeChecker, BNFC.GetCF, BNFC.Lexing, BNFC.Backend.Base BNFC.Backend.Common, BNFC.Backend.Common.Makefile, BNFC.Backend.Common.NamedVariables, BNFC.Backend.Common.OOAbstract, BNFC.Backend.Common.StrUtils, BNFC.Options, BNFC.WarningM, Data.Pair, BNFC.Backend.Utils, BNFC.PrettyPrint, -- Documentation backends BNFC.Backend.Latex, BNFC.Backend.Txt2Tag, -- Haskell backend BNFC.Backend.Haskell, BNFC.Backend.Haskell.ToCNF, BNFC.Backend.Haskell.RegToAlex, BNFC.Backend.Haskell.CFtoTemplate, BNFC.Backend.Haskell.CFtoAlex3, BNFC.Backend.Haskell.CFtoAlex2, BNFC.Backend.Haskell.CFtoAlex, BNFC.Backend.Haskell.CFtoHappy, BNFC.Backend.Haskell.CFtoPrinter, BNFC.Backend.Haskell.CFtoAbstract, BNFC.Backend.Haskell.CFtoLayout, BNFC.Backend.Haskell.MkErrM, BNFC.Backend.Haskell.MkSharedString, BNFC.Backend.Haskell.HsOpts, BNFC.Backend.Haskell.Utils, -- Profile BNFC.Backend.HaskellProfile, BNFC.Backend.HaskellProfile.CFtoHappyProfile, -- Haskell GADT BNFC.Backend.HaskellGADT, BNFC.Backend.HaskellGADT.HaskellGADTCommon, BNFC.Backend.HaskellGADT.CFtoTemplateGADT, BNFC.Backend.HaskellGADT.CFtoAbstractGADT, -- O'Caml backend BNFC.Backend.OCaml, BNFC.Backend.OCaml.OCamlUtil, BNFC.Backend.OCaml.CFtoOCamlTest, BNFC.Backend.OCaml.CFtoOCamlShow, BNFC.Backend.OCaml.CFtoOCamlPrinter, BNFC.Backend.OCaml.CFtoOCamlTemplate, BNFC.Backend.OCaml.CFtoOCamlAbs, BNFC.Backend.OCaml.CFtoOCamlYacc, BNFC.Backend.OCaml.CFtoOCamlLex, -- C backend BNFC.Backend.C, BNFC.Backend.C.CFtoCPrinter, BNFC.Backend.C.CFtoCSkel, BNFC.Backend.C.CFtoBisonC, BNFC.Backend.C.CFtoFlexC, BNFC.Backend.C.CFtoCAbs, BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel, -- C++ backend BNFC.Backend.CPP.NoSTL, BNFC.Backend.CPP.PrettyPrinter, BNFC.Backend.CPP.NoSTL.RegToFlex, BNFC.Backend.CPP.NoSTL.CFtoFlex, BNFC.Backend.CPP.NoSTL.CFtoBison, BNFC.Backend.CPP.NoSTL.CFtoCPPAbs, -- C++ STL backend BNFC.Backend.CPP.STL, BNFC.Backend.CPP.STL.CFtoBisonSTL, BNFC.Backend.CPP.STL.CFtoSTLAbs, BNFC.Backend.CPP.STL.STLUtils, BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL, -- C# backend BNFC.Backend.CSharp, BNFC.Backend.CSharp.RegToGPLEX, BNFC.Backend.CSharp.CFtoGPLEX, BNFC.Backend.CSharp.CSharpUtils, BNFC.Backend.CSharp.CFtoCSharpPrinter, BNFC.Backend.CSharp.CAbstoCSharpAbs, BNFC.Backend.CSharp.CAbstoCSharpAbstractVisitSkeleton, BNFC.Backend.CSharp.CAbstoCSharpVisitSkeleton, BNFC.Backend.CSharp.CFtoGPPG, -- Java backend BNFC.Backend.Java BNFC.Backend.Java.CFtoJavaAbs15, BNFC.Backend.Java.CFtoAllVisitor, BNFC.Backend.Java.CFtoFoldVisitor, BNFC.Backend.Java.CFtoAbstractVisitor, BNFC.Backend.Java.CFtoComposVisitor, BNFC.Backend.Java.CFtoVisitSkel15, BNFC.Backend.Java.CFtoJavaPrinter15, BNFC.Backend.Java.CFtoJLex15, BNFC.Backend.Java.CFtoCup15, BNFC.Backend.Java.RegToJLex -- XML backend BNFC.Backend.XML -- Pygments backend BNFC.Backend.Pygments -- --- Testing -------------------------------------------------------------- Test-suite unit-tests Type: exitcode-stdio-1.0 Build-Depends: base>=4 && <5, mtl, directory, array, process, filepath, pretty, hspec, QuickCheck >= 2.5, HUnit, temporary, containers, deepseq Main-is: unit-tests.hs HS-source-dirs: src test extensions: OverloadedStrings RecordWildCards FlexibleContexts Other-modules: BNFC.Backend.Common.MakefileSpec BNFC.Backend.Haskell.CFtoHappySpec BNFC.Backend.HaskellGADTSpec BNFC.Backend.HaskellSpec BNFC.OptionsSpec BNFC.WarningMSpec -- need to be there for alex to work LexBNF ParBNF Test-suite bnfc-doctests type: exitcode-stdio-1.0 ghc-options: -threaded main-is: doctests.hs build-depends: base, doctest >= 0.8 HS-source-dirs: test BNFC-2.8.1/LICENSE0000644000000000000000000004313112654616013011433 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.8.1/src/0000755000000000000000000000000012654616013011213 5ustar0000000000000000BNFC-2.8.1/src/PrintBNF.hs0000644000000000000000000002320612654616013013174 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 0 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 0 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.8.1/src/BNF.cf0000644000000000000000000001024412654616013012133 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.8.1/src/ErrM.hs0000644000000000000000000000143612654616013012420 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) import Control.Applicative (Applicative(..), Alternative(..)) 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 >>= _ = Bad s instance Applicative Err where pure = Ok (Bad s) <*> _ = Bad s (Ok f) <*> o = liftM f o instance Functor Err where fmap = liftM instance MonadPlus Err where mzero = Bad "Err.mzero" mplus (Bad _) y = y mplus x _ = x instance Alternative Err where empty = mzero (<|>) = mplus BNFC-2.8.1/src/ParBNF.y0000644000000000000000000001577112654616013012470 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 $$) } %% 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.8.1/src/Main.hs0000644000000000000000000000610612654616013012436 0ustar0000000000000000{- BNF Converter: Main file Copyright (C) 2002-2013 Authors: Jonas Almström Duregård, Krasimir Angelov, Jean-Philippe Bernardy, Björn Bringert, Johan Broberg, Paul Callaghan, Grégoire Détrez, Markus Forsberg, Ola Frid, Peter Gammie, Thomas Hallgren, Patrik Jansson, Kristofer Johannisson, Antti-Juhani Kaijanaho, Ulf Norell, Michael Pellauer and Aarne Ranta 2002 - 2013. 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 BNFC.Backend.Base hiding (Backend) import BNFC.Backend.C import BNFC.Backend.CPP.NoSTL import BNFC.Backend.CPP.STL import BNFC.Backend.CSharp import BNFC.Backend.Haskell import BNFC.Backend.HaskellGADT import BNFC.Backend.HaskellProfile import BNFC.Backend.Java import BNFC.Backend.Latex import BNFC.Backend.OCaml import BNFC.Backend.Pygments import BNFC.GetCF import BNFC.Options hiding (make) import Paths_BNFC ( version ) import Data.Version ( showVersion ) import System.Environment (getArgs) import System.Exit (exitFailure,exitSuccess) import System.IO (stderr, hPutStrLn) -- Print an error message and a (short) usage help and exit printUsageErrors :: [String] -> IO () printUsageErrors msg = do mapM_ (hPutStrLn stderr) msg hPutStrLn stderr usage exitFailure main :: IO () main = do args <- getArgs case parseMode args of UsageError e -> printUsageErrors [e] Help -> putStrLn help >> exitSuccess Version -> putStrLn (showVersion version) >> exitSuccess Target options file | target options == TargetProfile -> readFile file >>= parseCFP options TargetProfile >>= writeFiles (outDir options) . makeHaskellProfile options Target options file -> readFile file >>= parseCF options (target options) >>= make (target options) options where make t opts cf = writeFiles (outDir opts) $ (maketarget t) opts cf maketarget t = case t of TargetC -> makeC TargetCpp -> makeCppStl TargetCppNoStl -> makeCppNoStl TargetCSharp -> makeCSharp TargetHaskell -> makeHaskell TargetHaskellGadt -> makeHaskellGadt TargetLatex -> makeLatex TargetJava -> makeJava TargetOCaml -> makeOCaml TargetProfile -> error "Not implemented" TargetPygments -> makePygments BNFC-2.8.1/src/LexBNF.x0000644000000000000000000001410212654616013012460 0ustar0000000000000000-- -*- haskell -*- -- This Alex file was machine-generated by the BNF converter { {-# OPTIONS -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -w #-} module LexBNF where import qualified Data.Bits import Data.Word (Word8) import Data.Char (ord) } $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 :: (Posn -> String -> Token) -> (Posn -> String -> Token) 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 :: [Token] -> String tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l tokenPos (Err (Pn _ l _) :_) = "line " ++ show l tokenPos _ = "end of file" tokenPosn :: Token -> Posn tokenPosn (PT p _) = p tokenPosn (Err p) = p tokenLineCol :: Token -> (Int, Int) tokenLineCol = posLineCol . tokenPosn posLineCol :: Posn -> (Int, Int) posLineCol (Pn _ l c) = (l,c) mkPosToken :: Token -> ((Int, Int), String) mkPosToken t@(PT p _) = (posLineCol p, prToken t) prToken :: Token -> String 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 Err _ -> "#Error" 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 :: BTree 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.8.1/src/AbsBNF.hs0000644000000000000000000000377612654616013012617 0ustar0000000000000000 module AbsBNF where -- Haskell module generated by the BNF converter newtype Ident = Ident String deriving (Eq,Ord,Show,Read) data LGrammar = LGr [LDef] deriving (Eq,Ord,Show,Read) data LDef = DefAll Def | DefSome [Ident] Def | LDefView [Ident] deriving (Eq,Ord,Show,Read) data Grammar = Grammar [Def] deriving (Eq,Ord,Show,Read) 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,Read) data Item = Terminal String | NTerminal Cat deriving (Eq,Ord,Show,Read) data Cat = ListCat Cat | IdCat Ident deriving (Eq,Ord,Show,Read) data Label = LabNoP LabelId | LabP LabelId [ProfItem] | LabPF LabelId LabelId [ProfItem] | LabF LabelId LabelId deriving (Eq,Ord,Show,Read) data LabelId = Id Ident | Wild | ListE | ListCons | ListOne deriving (Eq,Ord,Show,Read) data ProfItem = ProfIt [IntList] [Integer] deriving (Eq,Ord,Show,Read) data IntList = Ints [Integer] deriving (Eq,Ord,Show,Read) data Separation = SepNone | SepTerm String | SepSepar String deriving (Eq,Ord,Show,Read) data Arg = Arg Ident deriving (Eq,Ord,Show,Read) data Exp = Cons Exp Exp | App Ident [Exp] | Var Ident | LitInt Integer | LitChar Char | LitString String | LitDouble Double | List [Exp] deriving (Eq,Ord,Show,Read) data RHS = RHS [Item] deriving (Eq,Ord,Show,Read) data MinimumSize = MNonempty | MEmpty deriving (Eq,Ord,Show,Read) 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,Read) BNFC-2.8.1/src/Data/0000755000000000000000000000000012654616013012064 5ustar0000000000000000BNFC-2.8.1/src/Data/Pair.hs0000644000000000000000000000044012654616013013311 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.8.1/src/BNFC/0000755000000000000000000000000012654616013011723 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Lexing.hs0000644000000000000000000000560412654616013013512 0ustar0000000000000000module BNFC.Lexing ( mkLexer, LexType(..) ) where import Control.Arrow ((&&&)) import Data.List (inits) import AbsBNF (Reg(..)) import PrintBNF import BNFC.CF p :: Reg -> IO () p = putStrLn . concat . words . printTree -- Abstract lexer data LexType = LexComment | LexToken String | LexSymbols mkLexer :: CF -> [(Reg, LexType)] mkLexer cf = -- comments [ (mkRegSingleLineComment s, LexComment) | s <- snd (comments cf) ] ++ [ (mkRegMultilineComment b e, LexComment) | (b,e) <- fst (comments cf) ] ++ -- user tokens [ (reg, LexToken name) | (Cat name, reg) <- tokenPragmas cf] ++ -- predefined tokens [ ( regIdent, LexToken "Ident" ) ] ++ -- Symbols [ (foldl1 RAlt (map RSeqs (symbols cf)), LexSymbols ) ] ++ -- Built-ins [ ( regInteger, LexToken "Integer") , ( regDouble, LexToken "Double" ) , ( regString, LexToken "String" ) , ( regChar, LexToken "Char" ) ] (<>) = RSeq (<|>) = RAlt -- Bult-in tokens -- the tests make sure that they correspond to what is in the LBNF reference -- | Ident regex -- >>> p regIdent -- letter(letter|digit|'_'|'\'')* regIdent :: Reg regIdent = RLetter <> RStar (RLetter <|> RDigit <|> RChar '_' <|> RChar '\'') -- | Integer regex -- >>> p regInteger -- digit+ regInteger :: Reg regInteger = RPlus RDigit -- | String regex -- >>> p regString -- '"'(char-["\"\\"]|'\\'["\"\\nt"])*'"' regString :: Reg regString = RChar '"' <> RStar ( RMinus RAny (RAlts "\"\\") <|> (RChar '\\' <> RAlts "\"\\nt")) <> RChar '"' -- | Char regex -- >>> p regChar -- '\''(char-["'\\"]|'\\'["'\\nt"])'\'' regChar :: Reg regChar = RChar '\'' <> (RMinus RAny (RAlts "'\\") <|> (RChar '\\' <> RAlts "'\\nt")) <> RChar '\'' -- | Double regex -- >>> p regDouble -- digit+'.'digit+('e''-'?digit+)? regDouble :: Reg regDouble = RPlus RDigit <> RChar '.' <> RPlus RDigit <> ROpt (RChar 'e' <> ROpt (RChar '-') <> RPlus RDigit) -- | Create regex for single line comments -- >>> p $ mkRegSingleLineComment "--" -- {"--"}(char*'\n') mkRegSingleLineComment :: String -> Reg mkRegSingleLineComment s = RSeq (RSeqs s) (RSeq (RStar RAny) (RChar '\n')) -- | Create regex for multiline comments -- >>> p $ mkRegMultilineComment "<" ">" -- '<'((char|'\n')-'>')*'>' -- >>> p $ mkRegMultilineComment "" -- {""} mkRegMultilineComment :: String -> String -> Reg mkRegMultilineComment b e = rseq $ concat [ lit b , [RStar (foldl1 RAlt subregex)] , [ RStar (RChar (head e)) | length e > 1 ] , lit e] where rseq = foldl1 RSeq lit :: String -> [Reg] lit "" = [] lit [c] = [RChar c] lit s = [RSeqs s] prefixes = map (init &&& last) (drop 1 (inits e)) subregex = [rseq (lit ss ++ [RMinus (RAlt RAny (RChar '\n')) (RChar s)]) | (ss,s) <- prefixes] BNFC-2.8.1/src/BNFC/CF.hs0000644000000000000000000006233212654616013012555 0ustar0000000000000000{-# LANGUAGE PatternGuards, DeriveFunctor #-} {- 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 BNFC.CF ( -- Types. CF, CFG(..), pragmasOfCF, -- ... Rule, Rul(..), lookupRule, Pragma(..), Exp(..), Literal, Symbol, KeyWord, Cat(..), strToCat, catString, catInteger, catDouble, catChar, catIdent, NonTerminal, 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. getAbstractSyntax, -- 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 allCatsNorm, 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 rulesForNormalizedCat, -- 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. isTokenCat, -- Information functions for list functions. isNilFun, -- empty list function? ([]) isOneFun, -- one element list function? (:[]) hasOneFunc, getCons, getSeparatorByPrecedence, 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 catOfList, comments, -- translates the pragmas into two list containing the s./m. comments tokenPragmas, -- get the user-defined regular expression tokens tokenNames, -- get the names of all user-defined tokens 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, isPositionCat, hasIdent, hasLayout, layoutPragmas, normFun, CFP, -- CF with profiles RuleP, FunP, Prof, cf2cfpRule, cf2cfp, cfp2cf, trivialProf, rulesOfCFP, funRuleP, ruleGroupsP, allCatsP, allEntryPointsP ) where import BNFC.Utils (prParenth,(+++)) import Control.Monad (guard) import Data.List (nub, intersperse, sort, group, intercalate, find, sortBy) import Data.Char import AbsBNF (Reg()) import ParBNF (pCat) import LexBNF (tokens) import qualified AbsBNF import ErrM -- | 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) = unwords (show f : "." : show cat : "::=" : 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 x = Left x -- | 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 -> [(Cat,Reg)] tokenPragmas cf = [(TokenCat name,e) | TokenReg name _ e <- pragmasOfCF cf] -- | The names of all user-defined tokens tokenNames :: CFG f -> [String] tokenNames cf = map (show.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 = String type Symbol = String type KeyWord = String ------------------------------------------------------------------------------ -- Categories ------------------------------------------------------------------------------ -- | Categories are the Non-terminals of the grammar. data Cat = InternalCat -- | Internal category, inserted in 1st -- position in "internal" rules, -- essentially ensuring that they are -- never parsed. | Cat String | TokenCat String -- ^ Token types (like Ident) | ListCat Cat | CoercCat String Integer deriving (Eq, Ord) -- An alias for Cat used in many backends: type NonTerminal = Cat -- | Render category symbols as strings -- >>> catToStr (Cat "Def") -- "Def" -- >>> catToStr (ListCat (Cat "Thing")) -- "[Thing]" -- >>> catToStr (CoercCat "Expr" 3) -- "Expr3" -- >>> catToStr (ListCat (CoercCat "Expr" 2)) -- "[Expr2]" -- >>> catToStr (TokenCat "Abc") -- "Abc" catToStr InternalCat = "#" catToStr (Cat s) = s catToStr (TokenCat s) = s catToStr (ListCat c) = "[" ++ show c ++ "]" catToStr (CoercCat s i) = s ++ show i instance Show Cat where show = catToStr -- | Reads a string into a category. This should only needs to handle -- the case of simple categories (with or without coercion) since list -- categories are parsed in the grammar already. To be on the safe side here, -- we still call the parser function that parses categries. -- >>> strToCat "Abc" == Cat "Abc" -- True -- >>> strToCat "Abc123" == CoercCat "Abc" 123 -- True -- >>> strToCat "[Expr2]" == ListCat (CoercCat "Expr" 2) -- True strToCat :: String -> Cat strToCat "#" = InternalCat strToCat s = case pCat (tokens s) of Ok c -> cat2cat c Bad _ -> Cat s -- error $ "Error parsing cat " ++ s ++ " (" ++ e ++ ")" -- Might be one of the "Internal cat" which are not -- really parsable... where cat2cat (AbsBNF.IdCat (AbsBNF.Ident i)) = case span isDigit (reverse i) of ([],c') -> Cat (reverse c') (d,c') -> CoercCat (reverse c') (read (reverse d)) cat2cat (AbsBNF.ListCat c) = ListCat (cat2cat c) -- Build-in categories contants catString, catInteger, catDouble, catChar, catIdent :: Cat catString = TokenCat "String" catInteger = TokenCat "Integer" catDouble = TokenCat "Double" catChar = TokenCat "Char" catIdent = TokenCat "Ident" -- the parser needs these specialCatsP :: [String] specialCatsP = words "Ident Integer String Char Double" -- | Does the category correspond to a data type? isDataCat :: Cat -> Bool isDataCat c = isDataOrListCat c && not (isList c) isDataOrListCat :: Cat -> Bool isDataOrListCat (CoercCat _ _) = False isDataOrListCat (Cat ('@':_)) = False isDataOrListCat (ListCat c) = isDataOrListCat c isDataOrListCat _ = True -- | Categories C1, C2,... (one digit in end) are variants of C. This function -- returns true if two category are variants of the same abstract category. -- E.g. -- -- >>> eqCat (Cat "Abc") (Cat "Abc") -- True -- >>> eqCat (CoercCat "Abc" 3) (CoercCat "Abc" 5) -- True -- >>> eqCat (CoercCat "Acb" 4) (CoercCat "Abc" 4) -- False -- >>> eqCat (Cat "Abc") (CoercCat "Abc" 44) -- True eqCat :: Cat -> Cat -> Bool eqCat (CoercCat c1 _) (CoercCat c2 _) = c1 == c2 eqCat (Cat c1 ) (CoercCat c2 _) = c1 == c2 eqCat (CoercCat c1 _) (Cat c2) = c1 == c2 eqCat c1 c2 = c1 == c2 -- | Removes precendence information. C1 => C, [C2] => [C] normCat :: Cat -> Cat normCat (ListCat c) = ListCat (normCat c) normCat (CoercCat c _) = Cat c normCat c = c 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 (ListCat (Cat "C")) -- [C] -- "ListC" -- >>> identCat (CoercCat "C" 3) -- "C3" identCat :: Cat -> String identCat (ListCat c) = "List" ++ identCat c identCat c = show c isList :: Cat -> Bool isList (ListCat _) = True isList _ = False isTokenCat :: Cat -> Bool isTokenCat (TokenCat _) = True isTokenCat _ = False -- | Unwraps the list constructor from the category name. Eg. [C1] => C1 -- E.g. -- >>> catOfList (ListCat (Cat "A")) -- A -- >>> catOfList (Cat "B") -- B catOfList :: Cat -> Cat catOfList (ListCat c) = c catOfList c = c ------------------------------------------------------------------------------ -- Functions ------------------------------------------------------------------------------ -- | Fun is the function name of a rule. type Fun = String -- | Either Cat or Fun -- | 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 isDefinedRule [] = error "isDefinedRule: empty function name" isProperLabel :: Fun -> Bool isProperLabel f = not (isCoercion f || isDefinedRule f) -- | FIXME: This is a copy of the old normCat function that some backend use -- on Fun. Now that the type of Cat has changed, this is no longer possible -- so this is added for those odd cases. It should be verified if this is -- really necessary. normFun :: Fun -> Fun normFun f = case f of '[':cs -> "[" ++ norm (init cs) ++ "]" _ -> norm f where norm = reverse . dropWhile isDigit . reverse 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 == "(++)" ------------------------------------------------------------------------------ type Name = String -- | 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)] -- 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 = [r | r <- rulesOfCF cf, isParsable r, valCat r == cat] -- | Like rulesForCat but for normalized value categories. -- I.e., `rulesForCat (Cat "Exp")` will return rules for category Exp but also -- Exp1, Exp2... in case of coercion rulesForNormalizedCat :: CF -> Cat -> [Rule] rulesForNormalizedCat cf cat = [r | r <- rulesOfCF cf, isParsable r, normCat (valCat r) == cat] -- | As rulesForCat, but this version doesn't exclude internal rules. rulesForCat' :: CF -> Cat -> [Rule] rulesForCat' cf cat = [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 -> [String] allCatsIdNorm = nub . map (identCat . normCat) . allCats -- | Get all normalized Cat allCatsNorm :: CF -> [Cat] allCatsNorm = nub . map normCat . allCats -- | Is the category is used on an rhs? isUsedCat :: CFG f -> Cat -> Bool isUsedCat cf cat = cat `elem` [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 -> [Cat] literals cf = [TokenCat l | l <- lits] ++ owns where (lits,_,_,_) = infoOfCF cf owns = map fst (tokenPragmas cf) -- | 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 catIdent -- 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 (TokenCat "Ident":) else id) (map fst (tokenPragmas cf)) -- 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 -- -- The abstract syncax, instanciated by the Data type, is the type signatures -- of all the constructors. -- | Return the abstract syntax of the grammar. -- All categories are normalized, so a rule like: -- EAdd . Exp2 ::= Exp2 "+" Exp3 ; -- Will give the following signature: EAdd : Exp -> Exp -> Exp getAbstractSyntax :: CF -> [(Cat, [(Fun, [Cat])])] getAbstractSyntax cf = [ ( c, nub (constructors c) ) | c <- allCatsNorm cf ] where constructors cat = do rule <- rulesOfCF cf let f = funRule rule guard $ not (isDefinedRule f) guard $ not (isCoercion f) guard $ normCat (valCat rule) == cat let cs = [normCat c | Left c <- rhsRule rule, c /= InternalCat] return (f, cs) -- All the function bellow are variation arround the idea of getting the -- abstract syntax of the grammar with some variation but they seem to do a -- poor job at handling corner cases involving coercions. Use getAbstractSyntax -- instead if possible. 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) = (f,[normCat c | Left c <- its, c /= InternalCat]) cf2data :: CF -> [Data] cf2data = cf2data' isDataCat cf2dataLists :: CF -> [Data] cf2dataLists = cf2data' isDataOrListCat specialData :: CF -> [Data] specialData cf = [(c,[(show c,[TokenCat "String"])]) | c <- specialCats cf] where -- to deal with coercions -- the Haskell convention: the wildcard _ is not a constructor -- | Checks if the rule is parsable. isParsable :: Rul f -> Bool isParsable (Rule _ _ (Left c:_)) = c /= InternalCat isParsable _ = True -- | 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 rs = case find (isConsFun . funRule) rs of Just (Rule _ _ cats) -> seper cats Nothing -> error $ "getCons: no construction function found in " ++ intercalate ", " (map (show . funRule) rs) where seper [] = [] seper (Right x:_) = x seper (Left _:xs) = seper xs -- | Helper function that gets the list separator by precedence level getSeparatorByPrecedence :: [Rule] -> [(Integer,String)] getSeparatorByPrecedence rules = [ (p, getCons (getRulesFor p)) | p <- precedences ] where precedences = sortBy (flip compare) $ nub $ map precRule rules getRulesFor p = [ r | r <- rules, precRule r == p ] isEmptyListCat :: CF -> Cat -> Bool isEmptyListCat cf c = elem "[]" $ map funRule $ rulesForCat' cf c isNonterm :: Either Cat String -> Bool isNonterm (Left _) = True isNonterm (Right _) = 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 isConsFun (funRule r1) && tryRev r1 r2 _ -> False tryRev (Rule f _ ts@(x:_:_)) r = isEmptyNilRule r && isConsFun f && isNonterm x && isNonterm (last ts) tryRev _ _ = False isEmptyNilRule :: Rul Fun -> Bool isEmptyNilRule (Rule f _ ts) = isNilFun f && null ts -- | Returns the precedence of a category symbol. -- E.g. -- -- >>> precCat (Cat "Abc") -- 0 -- -- >>> precCat (CoercCat "Abc" 4) -- 4 -- -- But! -- >>> precCat (ListCat (CoercCat "Abc" 2)) -- 2 precCat :: Cat -> Integer precCat (CoercCat _ i) = i precCat (ListCat c) = precCat c precCat _ = 0 precRule :: Rule -> Integer precRule = precCat . valCat precLevels :: CF -> [Integer] precLevels cf = sort $ nub [ precCat c | c <- allCats cf] precCF :: CF -> Bool precCF cf = length (precLevels cf) > 1 -- | Does the category have a position stored in AST? isPositionCat :: CFG f -> Cat -> Bool isPositionCat cf cat = or [b | TokenReg name b _ <- pragmasOfCF cf, TokenCat 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 = allEntryPoints BNFC-2.8.1/src/BNFC/ToCNFCore.hs0000644000000000000000000002143712654616013014010 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 BNFC.ToCNFCore (toCNF, isCat, group', catTag, punctuate', onRules, isUnitRule, splitOptim, second, lookupMulti, Set, CatDescriptions, UnitRel, RHSEl, Exp(..), prettyExp, appMany, app',after) 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 BNFC.CF hiding (App,Exp) import Control.Monad.RWS import Control.Applicative hiding (Const) import qualified Data.Map as M import Data.List (nub,sortBy,sort) import Data.Function (on) import Data.Char (isAlphaNum,ord) 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,neighbors) where cf01@(CFG (exts01,_)) = funToExp . onRules delInternal $ cf0 (rules',descriptions) = toBin (rulesOfCF cf01) cf1 = CFG (exts01,rules') cf2 = delNull cf1 units = unitSet cf2 neighbors = neighborSet cf2 funToExp :: CFG Fun -> CFG Exp funToExp = fmap toExp toExp f | isCoercion f = Id | otherwise = Con f delInternal = filter (not . isInternalRhs . rhsRule) where isInternalRhs (Left c:_) = c == InternalCat isInternalRhs _ = False 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) catTag :: Either Cat String -> Doc catTag (Left c) = "CAT_" <> text (concatMap escape (show 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 punctuate' p = cat . punctuate p -------------------------------------------------------------- -- 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' <- liftM 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 toBinRul r = return [r] prettyRHS = hcat . punctuate " " . map (either (text . show) (quotes . text)) --------------------------- -- Fixpoint utilities x ∪ y = sort $ nub (x ++ y) lookupMulti 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 _ 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 (appMany f) (cross (map nulls rhs))) where nulls (Right _) = [] nulls (Left cat) = lookupMulti cat nullset 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 _) = [] lk' (Left cat) = lookupMulti 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') <- lookupMulti (Left c) unitSet] where appl = case r of Left _ -> after Right _ -> app' unitRule _ _ = M.empty isUnitRule (Rule _ _ [_]) = True isUnitRule _ = False ------------------------ -- Left/Right occurences type RHSEl = Either Cat String isOnLeft, isOnRight :: RHSEl -> Rul f -> Bool isOnLeft c (Rule _ _ [c',_]) = c == c' isOnLeft _ _ = False isOnRight c (Rule _ _ [_,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 (Cat ('@':'@':_))) = 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 _ c rhs) = M.singleton (show c) (lkCat x s) where x = pos rhs lkCat (Right t) _ = [Right t] lkCat (Left c) s = Left c:lookupMulti (show c) s -- neighbors A B = ∃ A' B'. P ::= 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 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 after :: Exp -> Exp -> Exp after Id f = f after f Id = f after f g = f `After` g appMany f args = foldl app' f args BNFC-2.8.1/src/BNFC/MultiView.hs0000644000000000000000000000764512654616013014220 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 BNFC.MultiView where import System.Directory ( doesFileExist, renameFile ) import qualified BNFC.CF as CF import BNFC.Utils import ParBNF import PrintBNF import Data.List(nub,partition) import AbsBNF -- import LexBNF import ErrM import Data.Char import BNFC.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.8.1/src/BNFC/WarningM.hs0000644000000000000000000000120612654616013014000 0ustar0000000000000000module BNFC.WarningM where import qualified Control.Monad.Writer as W -- Monad that allows pure computation to output -- warnings type WithWarnings a = W.Writer [String] a -- Run the computation and return both the value -- and the warnings run :: WithWarnings a -> (a,[String]) run = W.runWriter -- Run the computation and print the warnings putWarnings :: WithWarnings a -> IO a putWarnings c = do let (v,warnings) = run c mapM_ putStrLn warnings return v hasWarnings :: WithWarnings a -> Bool hasWarnings c = let (v,warnings) = run c in not (null warnings) -- Output a warning warn :: String -> WithWarnings () warn s = W.tell [s] BNFC-2.8.1/src/BNFC/PrettyPrint.hs0000644000000000000000000000144512654616013014567 0ustar0000000000000000-- Extends Text.PrettyPrint module BNFC.PrettyPrint ( module Text.PrettyPrint , (<.>) , codeblock , vsep , (<=>) ) where import Text.PrettyPrint -- | Pretty print separator with a dot -- >>> "abc" <.> "py" -- abc.py (<.>) :: Doc -> Doc -> Doc a <.> b = a <> "." <> b -- | Code block. A bloc of code, surrounded by {} and indented. -- >>> codeblock 4 ["abc", "def"] -- { -- abc -- def -- } codeblock :: Int -> [Doc] -> Doc codeblock indent code = lbrace $+$ nest indent (vcat code) $+$ rbrace -- | List version of prettyPrint $+$ -- >>> vsep [text "abc", nest 4 (text "def")] -- abc -- def vsep :: [Doc] -> Doc vsep = foldl ($+$) empty -- | Pretty print separator with = (for assignments...) -- >>> "a" <=> "123" -- a = 123 (<=>) :: Doc -> Doc -> Doc a <=> b = a <+> "=" <+> b BNFC-2.8.1/src/BNFC/GetCF.hs0000644000000000000000000004446612654616013013225 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 BNFC.GetCF(parseCF, parseCFP) where import qualified AbsBNF as Abs import ParBNF import BNFC.CF import BNFC.Options import BNFC.TypeChecker import BNFC.Utils import Control.Arrow (left) import Control.Monad.State import Data.Char import Data.Either (partitionEithers) import Data.List(nub,partition) import Data.Maybe (mapMaybe) import ErrM -- $setup -- >>> import PrintBNF parseCF :: SharedOptions -> Target -> String -> IO CF parseCF opts t s = liftM cfp2cf (parseCFP opts t s) parseCFP :: SharedOptions -> Target -> String -> IO CFP parseCFP opts target content = do cfp <- runErr $ pGrammar (myLexer content) >>= expandRules >>= getCFP (cnf opts) >>= markTokenCategories let cf = cfp2cf cfp runErr $ checkDefinitions cf let msgs3 = checkTokens cf let reserved = [lang opts | target == TargetJava ] -- Warn of fail if the grammar use non unique names case filter (not . isDefinedRule) $ notUniqueNames reserved cf of [] -> return () ns| target `notElem` [TargetHaskell,TargetHaskellGadt,TargetOCaml] -> fail $ "ERROR: names not unique: " ++ unwords ns | otherwise -> do putStrLn $ "Warning: names not unique: " ++ unwords ns putStrLn "This can be an error in other back ends." -- Print msgs3 putStrLn $ unlines msgs3 -- Print the number of rules putStrLn $ show (length (rulesOfCF cf)) +++ "rules accepted\n" -- Print a warning if comment delimiter are bigger than 2 characters let c3s = [(b,e) | (b,e) <- fst (comments cf), length b > 2 || length e > 2] unless (null c3s) $do putStrLn "Warning: comment delimiters longer than 2 characters ignored in Haskell:" mapM_ putStrLn [b +++ "-" +++ e | (b,e) <- c3s] return cfp where runErr (Ok a) = return a runErr (Bad msg) = fail msg {- 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) -} getCFP :: Bool -> Abs.Grammar -> Err CFP getCFP cnf (Abs.Grammar defs0) = do let rules = inlineDelims rules0 cf0 = revs srt srt = let literals = nub [lit | xs <- map rhsRule rules, Left (Cat lit) <- xs, lit `elem` 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) case mapMaybe (checkRule (cfp2cf cf0)) (rulesOfCF cf0) of [] -> return () msgs -> fail (unlines msgs) return cf0 where (pragma,rules0) = partitionEithers $ concatMap transDef defs (defs,inlineDelims) = if cnf then (defs0,id) else removeDelims defs0 -- | This function goes through each rule of a grammar and replace Cat "X" with -- TokenCat "X" when "X" is a token type. markTokenCategories :: CFP -> Err CFP markTokenCategories (CFG (exts, rules)) = return $ CFG (exts, newRules) where newRules = [ Rule f (mark c) (map (left mark) rhs) | Rule f c rhs <- rules ] tokenCatNames = [ n | TokenReg n _ _ <- fst exts ] ++ specialCatsP mark = toTokenCat tokenCatNames -- | Change the constructor of categories with the given names from Cat to -- TokenCat -- >>> toTokenCat ["A"] (Cat "A") == TokenCat "A" -- True -- >>> toTokenCat ["A"] (ListCat (Cat "A")) == ListCat (TokenCat "A") -- True -- >>> toTokenCat ["A"] (Cat "B") == Cat "B" -- True toTokenCat :: [String] -> Cat -> Cat toTokenCat ns (Cat a) | a `elem` ns = TokenCat a toTokenCat ns (ListCat c) = ListCat (toTokenCat ns c) toTokenCat _ c = c removeDelims :: [Abs.Def] -> ([Abs.Def], [RuleP] -> [RuleP]) removeDelims xs = (ys ++ map delimToSep ds, foldr (.) id [map (inlineDelim' d) | d <- ds]) where (ds,ys) = partition isDelim xs isDelim (Abs.Delimiters{}) = True isDelim _ = False inlineDelim :: Abs.Def -> Either Cat String -> [Either Cat String] inlineDelim (Abs.Delimiters cat open close _ _) (Left c) | c == ListCat (transCat cat) = [Right open, Left c, Right close] inlineDelim _ x = [x] inlineDelim' :: Abs.Def -> RuleP -> RuleP inlineDelim' d@(Abs.Delimiters cat _ _ _ _) r@(Rule f c rhs) | c == ListCat (transCat cat) = r | otherwise = Rule f c (concatMap (inlineDelim d) rhs) inlineDelim' _ _ = error "Not a delimiters pragma" delimToSep (Abs.Delimiters cat _ _ (Abs.SepTerm s) sz) = Abs.Terminator sz cat s delimToSep (Abs.Delimiters cat _ _ (Abs.SepSepar s) sz) = Abs.Separator sz cat s delimToSep (Abs.Delimiters cat _ _ Abs.SepNone sz) = Abs.Terminator sz cat "" delimToSep x = x transDef :: Abs.Def -> [Either Pragma RuleP] transDef 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 (strToCat .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 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 :: Abs.Cat -> String -> String -> Abs.Separation -> Abs.MinimumSize -> [Rule] delimiterRules a0 l r (Abs.SepTerm "") size = delimiterRules a0 l r Abs.SepNone size delimiterRules a0 l r (Abs.SepSepar "") size = delimiterRules a0 l r Abs.SepNone size delimiterRules a0 l r sep size = [ -- recognizing a single element Rule "(:[])" (strToCat a') (Left a : termin), -- optional terminator/separator -- glueing two sublists Rule "(++)" (strToCat a') [Left (strToCat a'), Left (strToCat a')], -- starting on either side with a delimiter Rule "[]" (strToCat c) [Right l], Rule (if optFinal then "(:[])" else "[]") (strToCat d) ([Left a | optFinal] ++ [Right r]), -- gathering chains Rule "(++)" (strToCat c) [Left (strToCat c), Left (strToCat a')], Rule "(++)" (strToCat d) [Left (strToCat a'), Left (strToCat d)], -- finally, put together left and right chains Rule "(++)" as [Left (strToCat c),Left (strToCat d)]] ++ [ -- special rule for the empty list if necessary Rule "[]" as [Right l,Right r] | optEmpty] where a = transCat a0 as = ListCat a a' = '@':'@':show a c = '@':'{':show a d = '@':'}':show a -- optionally separated concat. of x and y categories. termin = case sep of Abs.SepSepar t -> [Right t] Abs.SepTerm t -> [Right t] _ -> [] optFinal = case (sep,size) of (Abs.SepSepar _,_) -> True (Abs.SepTerm _,Abs.MNonempty) -> True (Abs.SepNone,Abs.MNonempty) -> True _ -> False optEmpty = case sep of Abs.SepSepar _ -> size == Abs.MEmpty _ -> False 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 "_" (Cat c) [Left (CoercCat c 1)] : [Rule "_" (CoercCat c (i-1)) [Left (CoercCat c i)] | i <- [2..n]] ++ [Rule "_" (CoercCat c n) [Right "(", Left (Cat c), Right ")"]] ebnfRules :: Abs.Ident -> [Abs.RHS] -> [Rule] ebnfRules (Abs.Ident c) rhss = [Rule (mkFun k its) (strToCat c) (map transItem its) | (k, Abs.RHS its) <- zip [1 :: Int ..] rhss] where mkFun k 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 ("_'" :: String)) 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 -> ListCat (transCat cat) Abs.IdCat (Abs.Ident c) -> strToCat c 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 (show.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 _ (Rule _ (Cat ('@':_)) _) = 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 (map show badtypes) +++ "in" +++ s | badFunName = Just $ "Bad constructor name" +++ f +++ "in" +++ s | badMissing = Just $ "No production for" +++ unwords missing ++ ", appearing in rule" +++ s +++ ". Defined categories:" +++ unwords defineds | otherwise = Nothing where s = f ++ "." +++ show cat +++ "::=" +++ unwords (map (either show show) rhs) -- Todo: consider using the show instance of Rule c = normCat cat cs = [normCat c | Left c <- rhs] badCoercion = isCoercion f && [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 [ Cat x | x <- specialCatsP] && not (isCoercion f) badMissing = not (null missing) missing = filter nodef [show c | Left c <- rhs] nodef t = t `notElem` defineds defineds = show InternalCat : tokenNames cf ++ specialCatsP ++ map (show . valCat) (rulesOfCF cf) badTypeName = not (null badtypes) badtypes = filter isBadType $ cat : [c | Left c <- rhs] isBadType (ListCat c) = isBadType c isBadType InternalCat = False isBadType (CoercCat c _) = isBadCatName c isBadType (Cat s) = isBadCatName s isBadType (TokenCat s) = isBadCatName s isBadCatName s = not (isUpper (head s) || s == show InternalCat || (head s == '@')) badFunName = not (all (\c -> isAlphaNum c || c == '_') f {-isUpper (head f)-} || isCoercion f || isNilCons f) -- | Pre-processor that converts the `rules` macros to regular rules -- by creating unique function names for them. -- >>> :{ -- let rules1 = Abs.Rules (Abs.Ident "Foo") -- [ Abs.RHS [Abs.Terminal "abc"] -- , Abs.RHS [Abs.NTerminal (Abs.IdCat (Abs.Ident "A"))] -- , Abs.RHS [Abs.Terminal "foo", Abs.Terminal "bar"] -- , Abs.RHS [Abs.Terminal "++"] -- ] -- in -- let Ok tree = expandRules (Abs.Grammar [rules1]) -- in putStrLn (printTree tree) -- :} -- Foo_abc . Foo ::= "abc" ; -- FooA . Foo ::= A ; -- Foo1 . Foo ::= "foo" "bar" ; -- Foo2 . Foo ::= "++" -- -- Note that if there are two `rules` macro with the same category, the -- generated names should be uniques: -- >>> :{ -- let rules1 = Abs.Rules (Abs.Ident "Foo") -- [ Abs.RHS [Abs.Terminal "foo", Abs.Terminal "bar"] ] -- in -- let rules2 = Abs.Rules (Abs.Ident "Foo") -- [ Abs.RHS [Abs.Terminal "foo", Abs.Terminal "foo"] ] -- in -- let Ok tree = expandRules (Abs.Grammar [rules1, rules2]) -- in putStrLn (printTree tree) -- :} -- Foo1 . Foo ::= "foo" "bar" ; -- Foo2 . Foo ::= "foo" "foo" -- -- This is using a State monad to remember the last used index for a category. expandRules :: Abs.Grammar -> Err Abs.Grammar expandRules (Abs.Grammar defs) = return $ Abs.Grammar (concat (evalState (mapM expand defs) [])) where expand (Abs.Rules ident rhss) = mapM (mkRule ident) rhss expand other = return [other] mkRule :: Abs.Ident -> Abs.RHS -> State [(String, Int)] Abs.Def mkRule ident (Abs.RHS rhs) = do fun <- liftM (Abs.LabNoP . Abs.Id . Abs.Ident) (mkName ident rhs) return (Abs.Rule fun (Abs.IdCat ident) rhs) mkName :: Abs.Ident -> [Abs.Item] -> State [(String, Int)] String mkName (Abs.Ident cat) [Abs.Terminal s] | all (\c -> isAlphaNum c || elem c ("_'" :: String)) s = return (cat ++ "_" ++ s) mkName (Abs.Ident cat) [Abs.NTerminal (Abs.IdCat (Abs.Ident s))] = return (cat ++ s) mkName (Abs.Ident cat) _ = do i <- liftM (maybe 1 (+1) . lookup cat) get modify ((cat, i):) return (cat ++ show i) BNFC-2.8.1/src/BNFC/Utils.hs0000644000000000000000000001734712654616013013373 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 BNFC.Utils ( (+++), (++++) , mkName, mkNames, NameStyle(..) , lowerCase, upperCase, mixedCase, camelCase, snakeCase , replace, prParenth , writeFileRep ) where import Control.Arrow ((&&&)) import Control.DeepSeq (rnf) import Data.Char import Data.List (intercalate) import System.IO (IOMode(ReadMode),hClose,hGetContents,openFile) import System.IO.Error (tryIOError) import System.Directory (createDirectory, doesDirectoryExist, renameFile, removeFile) import BNFC.PrettyPrint infixr 5 +++ infixr 5 ++++ -- printing operations (+++), (++++) :: String -> String -> String a +++ b = a ++ " " ++ b a ++++ b = a ++ "\n" ++ b prParenth :: String -> String prParenth s = if s == "" then "" else "(" ++ s ++ ")" -- * 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] -- * File utilities -- | Write a file, after making a backup of an existing file with the same name. -- 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. -- / New version by TH, 2010-09-23 writeFileRep :: FilePath -> String -> IO () writeFileRep 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 -- force reading of contents of files to achieve compatibility with -- Windows IO handling as combining lazy IO with `readFile` and -- 2x `renameFile` on the open `path` file complains with -- "bnfc.exe: Makefile: MoveFileEx "Makefile" "Makefile.bak": permission -- denied (The process cannot access the file because it is being used -- by another process.)" readFile' :: FilePath -> IO String readFile' path' = do inFile <- openFile path' ReadMode contents <- hGetContents inFile rnf contents `seq` hClose inFile return contents -- *** Naming *** -- Because naming is hard (http://blog.codinghorror.com/i-shall-call-it-somethingmanager/) -- | Different case style data NameStyle = LowerCase -- ^ e.g. @lowercase@ | UpperCase -- ^ e.g. @UPPERCASE@ | SnakeCase -- ^ e.g. @snake_case@ | CamelCase -- ^ e.g. @CamelCase@ | MixedCase -- ^ e.g. @mixedCase@ deriving (Show, Eq) -- | Generate a name in the given case style taking into account the reserved -- word of the language. Note that despite the fact that those name are mainly -- to be used in code rendering (type Doc), we return a String here to allow -- further manipulation of the name (like disambiguation) which is not possible -- in the Doc type. -- Examples: -- >>> mkName [] LowerCase "FooBAR" -- "foobar" -- >>> mkName [] UpperCase "FooBAR" -- "FOOBAR" -- >>> mkName [] SnakeCase "FooBAR" -- "foo_bar" -- >>> mkName [] CamelCase "FooBAR" -- "FooBAR" -- >>> mkName [] CamelCase "Foo_bar" -- "FooBar" -- >>> mkName [] MixedCase "FooBAR" -- "fooBAR" -- >>> mkName ["foobar"] LowerCase "FooBAR" -- "foobar_" -- >>> mkName ["foobar", "foobar_"] LowerCase "FooBAR" -- "foobar__" mkName :: [String] -> NameStyle -> String -> String mkName reserved style s = notReserved name' where notReserved s | s `elem` reserved = notReserved (s ++ "_") | otherwise = s tokens = parseIdent s name' = case style of LowerCase -> map toLower (concat tokens) UpperCase -> map toUpper (concat tokens) CamelCase -> concatMap capitalize tokens MixedCase -> case concatMap capitalize tokens of "" -> "" c:cs -> toLower c:cs SnakeCase -> map toLower (intercalate "_" tokens) capitalize [] = [] capitalize (c:cs) = toUpper c:cs -- | Same as above but accept a list as argument and make sure that the -- names generated are uniques. -- >>> mkNames ["c"] LowerCase ["A", "b_", "a_", "c"] -- ["a1","b","a2","c_"] mkNames :: [String] -> NameStyle -> [String] -> [String] mkNames reserved style = disambiguateNames . map (mkName reserved style) -- | This one takes a list of names and makes sure each is unique, appending -- numerical suffix if needed -- >>> disambiguateNames ["a", "b", "a", "c"] -- ["a1","b","a2","c"] disambiguateNames :: [String] -> [String] disambiguateNames = disamb [] where disamb ns1 (n:ns2) | n `elem` (ns1 ++ ns2) = let i = length (filter (==n) ns1) + 1 in (n ++ show i) : disamb (n:ns1) ns2 | otherwise = n : disamb (n:ns1) ns2 disamb _ [] = [] -- | Heuristic to "parse" an identifier into separate componennts -- -- >>> parseIdent "abc" -- ["abc"] -- -- >>> parseIdent "Abc" -- ["Abc"] -- -- >>> parseIdent "WhySoSerious" -- ["Why","So","Serious"] -- -- >>> parseIdent "why_so_serious" -- ["why","so","serious"] -- -- >>> parseIdent "why-so-serious" -- ["why","so","serious"] -- -- Some corner cases -- >>> parseIdent "LBNFParser" -- ["LBNF","Parser"] -- -- >>> parseIdent "ILoveNY" -- ["I","Love","NY"] parseIdent :: String -> [String] parseIdent = p [] . map (classify &&& id) where classify c | isUpper c = U | isLower c = L | otherwise = O p [] [] = [] p acc [] = reverse acc: p [] [] p [] ((L,c):cs) = p [c] cs p [] ((U,c):cs) = p [c] cs p [] ((O,_):cs) = p [] cs p acc ((L,c1):cs@((L,_):_)) = p (c1:acc) cs p acc ((U,c1):cs@((L,_):_)) = reverse acc:p [c1] cs p acc ((U,c1):cs@((U,_):_)) = p (c1:acc) cs p acc ((L,c1):cs@((U,_):_)) = reverse (c1:acc) : p [] cs p acc ((U,c1):(O,_):cs) = reverse (c1:acc) : p [] cs p acc ((L,c1):(O,_):cs) = reverse (c1:acc) : p [] cs p acc ((O,_):cs) = reverse acc : p [] cs p acc [(_,c)] = p (c:acc) [] data CharClass = U | L | O -- | Ident to lower case -- >>> lowerCase "MyIdent" -- myident lowerCase :: String -> Doc lowerCase = text . mkName [] LowerCase -- | Ident to upper case -- >>> upperCase "MyIdent" -- MYIDENT upperCase :: String -> Doc upperCase = text . mkName [] UpperCase -- | Ident to camel case -- >>> camelCase "my_ident" -- MyIdent camelCase :: String -> Doc camelCase = text . mkName [] CamelCase -- | To mixed case -- >>> mixedCase "my_ident" -- myIdent mixedCase :: String -> Doc mixedCase = text . mkName [] MixedCase -- | To snake case -- >>> snakeCase "MyIdent" -- my_ident snakeCase :: String -> Doc snakeCase = text . mkName [] SnakeCase BNFC-2.8.1/src/BNFC/TypeChecker.hs0000644000000000000000000001217612654616013014474 0ustar0000000000000000 module BNFC.TypeChecker where import Control.Monad import Data.List import Data.Char import BNFC.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 $ show $ 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 = void $ checkDefinition' dummyConstructors ctx f xs e 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 _ (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 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 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.8.1/src/BNFC/Options.hs0000644000000000000000000003056112654616013013717 0ustar0000000000000000module BNFC.Options where import BNFC.CF (CF) import Data.Maybe (fromMaybe) import Data.Version ( showVersion ) import Paths_BNFC ( version ) import System.Console.GetOpt import System.FilePath (takeBaseName) import Text.Printf (printf) -- ~~~ Option data structures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- | To decouple the option parsing from the execution of the program, -- we introduce a data structure that holds the result of the -- parsing of the arguments. data Mode -- An error has been made by the user -- e.g. invalid argument/combination of arguments = UsageError String -- Basic modes: print some info and exits | Help | Version -- Normal mode, specifying the back end to use, -- the option record to be passed to the backend -- and the path of the input grammar file | Target SharedOptions FilePath deriving (Eq,Show,Ord) -- | Target languages data Target = TargetC | TargetCpp | TargetCppNoStl | TargetCSharp | TargetHaskell | TargetHaskellGadt | TargetLatex | TargetJava | TargetOCaml | TargetProfile | TargetPygments deriving (Eq,Bounded, Enum,Ord) -- Create a list of all target using the enum and bounded classes targets :: [Target] targets = [minBound..] instance Show Target where show TargetC = "C" show TargetCpp = "C++" show TargetCppNoStl = "C++ (without STL)" show TargetCSharp = "C#" show TargetHaskell = "Haskell" show TargetHaskellGadt = "Haskell (with GADT)" show TargetLatex = "Latex" show TargetJava = "Java" show TargetOCaml = "OCaml" show TargetProfile = "Haskell (with permutation profiles)" show TargetPygments = "Pygments" -- | Which version of Alex is targeted? data AlexVersion = Alex1 | Alex2 | Alex3 deriving (Show,Eq,Ord,Bounded,Enum) -- | Happy modes data HappyMode = Standard | GLR deriving (Eq,Show,Bounded,Enum,Ord) -- | This is the option record that is passed to the different backends data SharedOptions = Options -- Option shared by at least 2 backends { target :: Target , make :: Maybe String -- ^ The name of the Makefile to generate -- or Nothing for no Makefile. , inPackage :: Maybe String -- ^ The hierarchical package to put -- the modules in, or Nothing. , cnf :: Bool -- ^ Generate CNF-like tables? , lang :: String -- Haskell specific: , alexMode :: AlexVersion , jflex :: Bool , inDir :: Bool , shareStrings :: Bool , byteStrings :: Bool , glr :: HappyMode , xml :: Int , ghcExtensions :: Bool -- C++ specific , linenumbers :: Bool -- ^ Add and set line_number field for syntax classes -- C# specific , visualStudio :: Bool -- ^ Generate Visual Studio solution/project files , wcf :: Bool -- ^ Windows Communication Foundation , functor :: Bool , outDir :: FilePath -- ^ Target directory for generated files } deriving (Eq,Show,Ord) -- | We take this oportunity to define the type of the backend functions type Backend = SharedOptions -- ^ options -> CF -- ^ Grammar -> IO () defaultOptions :: SharedOptions defaultOptions = Options { cnf = False , target = TargetHaskell , inPackage = Nothing , make = Nothing , alexMode = Alex3 , inDir = False , shareStrings = False , byteStrings = False , glr = Standard , xml = 0 , ghcExtensions = False , lang = error "lang not set" , linenumbers = False , visualStudio = False , wcf = False , functor = False , outDir = "." , jflex = False } -- ~~~ Option definition ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- This defines bnfc's "global" options, like --help globalOptions :: [ OptDescr Mode ] globalOptions = [ Option [] ["help"] (NoArg Help) "show help", Option [] ["version","numeric-version"] (NoArg Version) "show version number"] -- | Options for the target languages -- targetOptions :: [ OptDescr Target ] targetOptions :: [ OptDescr (SharedOptions -> SharedOptions)] targetOptions = [ Option "" ["java"] (NoArg (\o -> o {target = TargetJava})) "Output Java code for use with JLex and CUP" , Option "" ["haskell"] (NoArg (\o -> o {target = TargetHaskell})) "Output Haskell code for use with Alex and Happy (default)" , Option "" ["haskell-gadt"] (NoArg (\o -> o {target = TargetHaskellGadt})) "Output Haskell code which uses GADTs" , Option "" ["latex"] (NoArg (\o -> o {target = TargetLatex})) "Output LaTeX code to generate a PDF description of the language" , Option "" ["c"] (NoArg (\o -> o {target = TargetC})) "Output C code for use with FLex and Bison" , Option "" ["cpp"] (NoArg (\o -> o {target = TargetCpp})) "Output C++ code for use with FLex and Bison" , Option "" ["cpp-nostl"] (NoArg (\o -> o {target = TargetCppNoStl})) "Output C++ code (without STL) for use with FLex and Bison" , Option "" ["csharp"] (NoArg (\o -> o {target = TargetCSharp})) "Output C# code for use with GPLEX and GPPG" , Option "" ["ocaml"] (NoArg (\o -> o {target = TargetOCaml})) "Output OCaml code for use with ocamllex and ocamlyacc" , Option "" ["profile"] (NoArg (\o -> o {target = TargetProfile})) "Output Haskell code for rules with permutation profiles" , Option "" ["pygments"] (NoArg (\o -> o {target = TargetPygments})) "Output a Python lexer for Pygments" ] -- | A list of the options and for each of them, the target language -- they apply to. specificOptions :: [(OptDescr (SharedOptions -> SharedOptions), [Target])] specificOptions = [ ( Option ['l'] [] (NoArg (\o -> o {linenumbers = True})) "Add and set line_number field for all syntax classes" , [TargetCpp] ) , ( Option ['p'] [] (ReqArg (\n o -> o {inPackage = Just n}) "") "Prepend to the package/module name" , [TargetCpp, TargetCSharp, TargetHaskell, TargetHaskellGadt, TargetProfile, TargetJava] ) , ( Option [] ["jflex"] (NoArg (\o -> o {jflex = True})) "Use JFlex instead of JLex for lexing" , [TargetJava] ) , ( Option [] ["vs"] (NoArg (\o -> o {visualStudio = True})) "Generate Visual Studio solution/project files" , [TargetCSharp] ) , ( Option [] ["wcf"] (NoArg (\o -> o {wcf = True})) "Add support for Windows Communication Foundation,\n by marking abstract syntax classes as DataContracts" , [TargetCSharp] ) , ( Option ['d'] [] (NoArg (\o -> o {inDir = True})) "Put Haskell code in modules Lang.* instead of Lang*" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["alex1"] (NoArg (\o -> o {alexMode = Alex1})) "Use Alex 1.1 as Haskell lexer tool" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["alex2"] (NoArg (\o -> o {alexMode = Alex2})) "Use Alex 2 as Haskell lexer tool" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["alex3"] (NoArg (\o -> o {alexMode = Alex3})) "Use Alex 3 as Haskell lexer tool (default)" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["sharestrings"] (NoArg (\o -> o {shareStrings = True})) "Use string sharing in Alex 2 lexer" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["bytestrings"] (NoArg (\o -> o {byteStrings = True})) "Use byte string in Alex 2 lexer" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["glr"] (NoArg (\o -> o {glr = GLR})) "Output Happy GLR parser" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["xml"] (NoArg (\o -> o {xml = 1})) "Also generate a DTD and an XML printer" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["xmlt"] (NoArg (\o -> o {xml = 2})) "DTD and an XML printer, another encoding" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["cnf"] (NoArg (\o -> o {cnf = True})) "Use the CNF parser instead of happy" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["ghc"] (NoArg (\o -> o {ghcExtensions = True})) "Use ghc-specific language extensions" , [TargetHaskell, TargetHaskellGadt, TargetProfile] ) , ( Option [] ["functor"] (NoArg (\o -> o {functor = True})) "Make the AST a functor and use it to store the position of the nodes" , [TargetHaskell] ) ] commonOption :: [OptDescr (SharedOptions -> SharedOptions)] commonOption = [ Option "m" ["makefile"] (OptArg (setMakefile . fromMaybe "Makefile") "MAKEFILE") "generate Makefile" , Option "o" ["outputdir"] (ReqArg (\n o -> o {outDir = n}) "DIR") "Redirects all generated files into DIR" ] where setMakefile = \mf -> \o -> o { make = Just mf } allOptions :: [OptDescr (SharedOptions -> SharedOptions)] allOptions = targetOptions ++ commonOption ++ map fst specificOptions -- ~~~ Help strings ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ title :: String title = unlines [ "The BNF Converter, "++showVersion version, "(c) Jonas Almström Duregård, Krasimir Angelov, Jean-Philippe Bernardy, Björn Bringert, Johan Broberg, Paul Callaghan, ", " Grégoire Détrez, Markus Forsberg, Ola Frid, Peter Gammie, Thomas Hallgren, Patrik Jansson, ", " Kristofer Johannisson, Antti-Juhani Kaijanaho, Ulf Norell, ", " Michael Pellauer and Aarne Ranta 2002 - 2013.", "Free software under GNU General Public License (GPL).", "Bug reports to bnfc-dev@googlegroups.com." ] usage :: String usage = "usage: bnfc [--version] [--help] [] file.cf" help :: String help = unlines $ usage:"" :usageInfo "Global options" globalOptions :usageInfo "Common option" commonOption :usageInfo "Target languages" targetOptions :map targetUsage helpTargets where helpTargets = [TargetHaskell, TargetJava, TargetCpp, TargetCSharp ] targetUsage t = usageInfo (printf "Special options for the %s backend" (show t)) (map fst $ filter(elem t . snd)specificOptions) -- ~~~ Parsing machinery ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- | Main parsing function parseMode :: [String] -> Mode parseMode args = case args' of [] -> Help _ -> case getOpt' Permute globalOptions args' of (mode:_,_,_,_) -> mode _ -> case getOpt Permute allOptions args' of (_,_,e:_) -> UsageError e (_,[],_) -> UsageError "Missing grammar file" (optionsUpdates, [grammar], []) -> let options = foldl (.) id optionsUpdates defaultOptions in Target (options {lang = takeBaseName grammar}) grammar (_,_,_) -> UsageError "Too many arguments" where args' = translateOldOptions args isUsageError :: Mode -> Bool isUsageError (UsageError _) = True isUsageError _ = False -- ~~~ Backward compatibility ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- A translating function to maintain backward compatiblicy -- with the old option syntay translateOldOptions :: [String] -> [String] translateOldOptions = concatMap translateOne where translateOne "-java" = return "--java" translateOne "-java1.5" = return "--java" translateOne "-c" = return "--c" translateOne "-cpp" = return "--cpp" translateOne "-cpp_stl" = return "--cpp" translateOne "-cpp_no_stl" = return "--cpp-nostl" translateOne "-csharp" = return "--csharp" translateOne "-ocaml" = return "--ocaml" translateOne "-fsharp" = return "fsharp" translateOne "-haskell" = return "--haskell" translateOne "-prof" = return "--profile" translateOne "-gadt" = return "--haskell-gadt" translateOne "-alex1" = return "--alex1" translateOne "-alex2" = return "--alex2" translateOne "-alex3" = return "--alex3" translateOne "-sharestrings" = return "--sharestring" translateOne "-bytestrings" = return "--bytestring" translateOne "-glr" = return "--glr" translateOne "-xml" = return "--xml" translateOne "-xmlt" = return "--xmlt" translateOne "-vs" = return "--vs" translateOne "-wcf" = return "--wcf" translateOne other = return other BNFC-2.8.1/src/BNFC/Backend/0000755000000000000000000000000012654616013013252 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/CSharp.hs0000644000000000000000000003553312654616013014777 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 BNFC.Backend.CSharp (makeCSharp) where import BNFC.CF import BNFC.Options import BNFC.Backend.Common.OOAbstract import BNFC.Backend.Common.Makefile import BNFC.Backend.Base import BNFC.Backend.CSharp.CAbstoCSharpAbs import BNFC.Backend.CSharp.CFtoGPLEX import BNFC.Backend.CSharp.CFtoGPPG import BNFC.Backend.CSharp.CAbstoCSharpVisitSkeleton import BNFC.Backend.CSharp.CAbstoCSharpAbstractVisitSkeleton import BNFC.Backend.CSharp.CFtoCSharpPrinter import BNFC.Backend.CSharp.CSharpUtils import System.Environment (getEnv) import System.Directory import System.IO import System.IO.Error (catchIOError) import System.Process import Data.Maybe import Control.Monad (when) import qualified BNFC.Backend.Common.Makefile as Makefile import System.FilePath ((<.>)) -- Control.Monad.State makeCSharp :: SharedOptions -> CF -> MkFiles () makeCSharp opts cf = do let namespace = fromMaybe (lang opts) 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 mkfile "Absyn.cs" absyn mkfile (namespace ++ ".l") gplex liftIO $ putStrLn " (Tested with GPLEX RC1)" mkfile (namespace ++ ".y") gppg liftIO $ putStrLn " (Tested with GPPG 1.0)" mkfile "AbstractVisitSkeleton.cs" absSkeleton mkfile "VisitSkeleton.cs" skeleton mkfile "Printer.cs" printer mkfile "Test.cs" (csharptest namespace cf) when vsfiles (writeVisualStudioFiles namespace) when makefile (writeMakefile opts namespace) where makefile = isJust $ make opts vsfiles = visualStudio opts wcfSupport = wcf opts maybenamespace = inPackage opts writeMakefile :: SharedOptions -> Namespace -> MkFiles () writeMakefile opts namespace = do mkMakefile opts makefile liftIO $ putStrLn "" liftIO $ putStrLn "-----------------------------------------------------------------------------" liftIO $ putStrLn "Generated Makefile, which uses mono. You may want to modify the paths to" liftIO $ putStrLn "GPLEX and GPPG - unless you are sure that they are globally accessible (the" liftIO $ putStrLn "default commands are \"mono gplex.exe\" and \"mono gppg.exe\", respectively." liftIO $ putStrLn "The Makefile assumes that ShiftReduceParser.dll is located in ./bin and that" liftIO $ putStrLn "is also where test.exe will be generated." liftIO $ putStrLn "-----------------------------------------------------------------------------" liftIO $ putStrLn "" where makefile = (unlines [ "MONO = mono", "MONOC = gmcs" , "MONOCFLAGS = -optimize -reference:${PARSERREF}" , "GPLEX = ${MONO} gplex.exe", "GPPG = ${MONO} gppg.exe" , "PARSERREF = bin/ShiftReduceParser.dll" , "CSFILES = Absyn.cs Parser.cs Printer.cs Scanner.cs Test.cs VisitSkeleton.cs AbstractVisitSkeleton.cs" ] ++) $ Makefile.mkRule "all" [ "test" ] [] $ Makefile.mkRule "clean" [] -- peteg: don't nuke what we generated - move that to the "vclean" target. [ "rm -f " ++ namespace ++ ".pdf test" ] $ Makefile.mkRule "distclean" [ "clean" ] [ "rm -f ${CSFILES}" , "rm -f " ++ unwords [namespace <.> ext | ext <- [ "l","y","tex" ]] , "rm -f Makefile" ] $ Makefile.mkRule "test" [ "Parser.cs", "Scanner.cs" ] [ "@echo \"Compiling test...\"" , "${MONOC} ${MONOCFLAGS} -out:bin/test.exe ${CSFILES}" ] $ Makefile.mkRule "Scanner.cs" [ namespace <.> "l" ] [ "${GPLEX} /out:$@ " ++ namespace <.> "l" ] $ Makefile.mkRule "Parser.cs" [ namespace <.> "y" ] [ "${GPPG} /gplex " ++ namespace <.> "y > $@" ] "" writeVisualStudioFiles :: Namespace -> MkFiles () writeVisualStudioFiles namespace = do guid <- projectguid mkfile (namespace ++ ".csproj") (csproj guid) mkfile (namespace ++ ".sln") (sln guid) mkfile "run-gp.bat" batchfile liftIO $ putStrLn "" liftIO $ putStrLn "-----------------------------------------------------------------------------" liftIO $ putStrLn "Visual Studio solution (.sln) and project (.csproj) files were written." liftIO $ putStrLn "The project file has a reference to GPLEX/GPPG's ShiftReduceParser. You will" liftIO $ putStrLn "have to either copy this file to bin\\ShiftReduceParser.dll or change the" liftIO $ putStrLn "reference so that it points to the right location (you can do this from" liftIO $ putStrLn "within Visual Studio)." liftIO $ putStrLn "Additionally, the project includes Parser.cs and Scanner.cs. These have not" liftIO $ putStrLn "been generated yet. You can use the run-gp.bat file to generate them, but" liftIO $ putStrLn "note that it requires gppg and gplex to be in your PATH." liftIO $ putStrLn "-----------------------------------------------------------------------------" liftIO $ 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 = show (head (allEntryPoints cf)) projectguid :: MkFiles String projectguid = do maybeFilePath <- findDirectory guid <- maybe getBadGUID getGoodGUID maybeFilePath return guid where getBadGUID :: MkFiles String getBadGUID = do liftIO $ putStrLn "-----------------------------------------------------------------------------" liftIO $ putStrLn "Could not find Visual Studio tool uuidgen.exe to generate project GUID!" liftIO $ putStrLn "You might want to put this tool in your PATH." liftIO $ putStrLn "-----------------------------------------------------------------------------" return "{00000000-0000-0000-0000-000000000000}" getGoodGUID :: FilePath -> MkFiles String getGoodGUID filepath = liftIO $ do let filepath' = "\"" ++ filepath ++ "\"" (_, hOut, _, _) <- runInteractiveCommand filepath' guid <- hGetLine hOut return ('{' : init guid ++ "}") findDirectory :: MkFiles (Maybe FilePath) findDirectory = liftIO $ 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.8.1/src/BNFC/Backend/HaskellGADT.hs0000644000000000000000000001153012654616013015631 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 BNFC.Backend.HaskellGADT (makeHaskellGadt) where -- import Utils import BNFC.Options import BNFC.Backend.Base hiding (Backend) import BNFC.Backend.Haskell.HsOpts import BNFC.CF import BNFC.Backend.Haskell.CFtoHappy import BNFC.Backend.Haskell.CFtoAlex import BNFC.Backend.Haskell.CFtoAlex2 import BNFC.Backend.Haskell.CFtoAlex3 import BNFC.Backend.HaskellGADT.CFtoAbstractGADT import BNFC.Backend.HaskellGADT.CFtoTemplateGADT import BNFC.Backend.Haskell.CFtoPrinter import BNFC.Backend.Haskell.CFtoLayout import BNFC.Backend.XML import BNFC.Backend.Haskell.MkErrM import BNFC.Backend.Haskell.MkSharedString import qualified BNFC.Backend.Common.Makefile as Makefile import qualified BNFC.Backend.Haskell as Haskell import Control.Monad(when) makeHaskellGadt :: SharedOptions -> CF -> MkFiles () makeHaskellGadt 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 mkfile (absFile opts) $ cf2Abstract (byteStrings opts) absMod cf composOpMod mkfile (composOpFile opts) $ composOp composOpMod case alexMode opts of Alex1 -> do mkfile (alexFile opts) $ cf2alex lexMod errMod cf liftIO $ putStrLn " (Use Alex 1.1 to compile.)" Alex2 -> do mkfile (alexFile opts) $ cf2alex2 lexMod errMod shareMod (shareStrings opts) (byteStrings opts) cf liftIO $ putStrLn " (Use Alex 2.0 to compile.)" Alex3 -> do mkfile (alexFile opts) $ cf2alex3 lexMod errMod shareMod (shareStrings opts) (byteStrings opts) cf liftIO $ putStrLn " (Use Alex 3.0 to compile.)" mkfile (happyFile opts) $ cf2HappyS parMod absMod lexMod errMod (glr opts) (byteStrings opts) False cf liftIO $ putStrLn " (Tested with Happy 1.15)" mkfile (templateFile opts) $ cf2Template (templateFileM opts) absMod errMod cf mkfile (printerFile opts) $ cf2Printer False False True prMod absMod cf when (hasLayout cf) $ mkfile (layoutFile opts) $ cf2Layout (alexMode opts == Alex1) (inDir opts) layMod lexMod cf mkfile (tFile opts) $ Haskell.testfile opts cf mkfile (errFile opts) $ errM errMod cf when (shareStrings opts) $ mkfile (shareFile opts) $ sharedString shareMod (byteStrings opts) cf Makefile.mkMakefile opts $ Haskell.makefile opts case xml opts of 2 -> makeXML opts True cf 1 -> makeXML opts False cf _ -> return () composOp :: String -> String composOp composOpMod = unlines [ "{-# LANGUAGE Rank2Types, PolyKinds #-}", "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.8.1/src/BNFC/Backend/Txt2Tag.hs0000644000000000000000000002113712654616013015107 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 BNFC.Backend.Txt2Tag (cfToTxt)where import BNFC.CF import AbsBNF (Reg (..)) import BNFC.Utils import Data.List 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 _ cf = unlines $ map stringLit $ filter (`notElem` [Cat "Ident"]) $ literals cf stringLit :: Cat -> String stringLit cat = unlines $ case show 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 [show 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 = intercalate ", " $ map (symbol.prt) ys mult = intercalate ", " $ 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 ((+++) . p) [] xs where p (Left r) = nonterminal r p (Right r) = terminal r prt :: String -> String prt s = s empty :: String empty = "**eps**" symbol :: String -> String symbol s = s tabular :: Int -> [[String]] -> String tabular _ xs = unlines [unwords (intersperse "|" (" " : x)) | x <- xs] terminal :: String -> String terminal s = "``" ++ s ++ "``" nonterminal :: Cat -> String nonterminal s = "//" ++ show 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.8.1/src/BNFC/Backend/OCaml.hs0000644000000000000000000001360412654616013014605 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 BNFC.Backend.OCaml (makeOCaml) where import Text.PrettyPrint (render) import BNFC.CF import BNFC.Backend.Base hiding (Backend) import BNFC.Backend.Common.Makefile import BNFC.Backend.OCaml.CFtoOCamlYacc import BNFC.Backend.OCaml.CFtoOCamlLex import BNFC.Backend.OCaml.CFtoOCamlAbs import BNFC.Backend.OCaml.CFtoOCamlTemplate import BNFC.Backend.OCaml.CFtoOCamlPrinter import BNFC.Backend.OCaml.CFtoOCamlShow import BNFC.Backend.OCaml.CFtoOCamlTest import BNFC.Backend.XML import BNFC.Utils import BNFC.Options import System.FilePath (pathSeparator, ()) -- naming conventions noLang :: SharedOptions -> String -> String noLang _ name = name withLang :: SharedOptions -> String -> String withLang opts name = name ++ lang opts mkMod :: (SharedOptions -> String -> String) -> String -> SharedOptions -> String mkMod addLang name opts = pref ++ if inDir opts then lang opts ++ "." ++ name else addLang opts name where pref = maybe "" (++".") (inPackage opts) mkFile :: (SharedOptions -> String -> String) -> String -> String -> SharedOptions -> FilePath mkFile addLang name ext opts = pref ++ if inDir opts then lang opts name ++ ext' else addLang opts name ++ if null ext then "" else ext' where pref = maybe "" (\p->pkgToDir p "") (inPackage opts) ext' = if null ext then "" else "." ++ ext absFile, absFileM, ocamllexFile, ocamllexFileM, ocamlyaccFile, ocamlyaccFileM, utilFile, templateFile, templateFileM, printerFile, printerFileM, tFile :: SharedOptions -> 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" 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" tFile = mkFile withLang "Test" "ml" utilFile = mkFile noLang "BNFC_Util" "ml" makeOCaml :: SharedOptions -> CF -> MkFiles () makeOCaml opts cf = do let absMod = absFileM opts lexMod = ocamllexFileM opts parMod = ocamlyaccFileM opts prMod = printerFileM opts showMod = showFileM opts do mkfile (absFile opts) $ cf2Abstract absMod cf mkfile (ocamllexFile opts) $ cf2ocamllex lexMod parMod cf mkfile (ocamlyaccFile opts) $ cf2ocamlyacc parMod absMod lexMod cf mkfile (templateFile opts) $ cf2Template (templateFileM opts) absMod cf mkfile (printerFile opts) $ cf2Printer prMod absMod cf mkfile (showFile opts) $ cf2show showMod absMod cf mkfile (tFile opts) $ render $ ocamlTestfile absMod lexMod parMod prMod showMod cf mkfile (utilFile opts) $ utilM mkMakefile opts $ makefile opts case xml opts of 2 -> makeXML opts True cf 1 -> makeXML opts False cf _ -> return () pkgToDir :: String -> FilePath pkgToDir s = replace '.' pathSeparator s codeDir :: SharedOptions -> 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 [pathSeparator] in pref ++ sep ++ dir makefile :: SharedOptions -> String makefile opts = mkRule "all" [] [ "ocamlyacc " ++ ocamlyaccFile opts , "ocamllex " ++ ocamllexFile opts , "ocamlc -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 ] $ mkRule "clean" [] [ "-rm -f " ++ unwords (map (dir++) [ "*.cmi", "*.cmo", "*.o" ]) ] $ mkRule "distclean" ["clean"] [ "-rm -f " ++ unwords [ 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*" ]] "" where dir = let d = codeDir opts in if null d then "" else d ++ [pathSeparator] 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.8.1/src/BNFC/Backend/Base.hs0000644000000000000000000000422212654616013014460 0ustar0000000000000000{- Backend base function. Defines the type of the backend and some usefull - functions -} module BNFC.Backend.Base ( Backend , MkFiles , execBackend , mkfile , liftIO , writeFiles ) where import BNFC.Utils (writeFileRep) import Control.Monad.Writer import System.Directory (createDirectoryIfMissing) import System.FilePath (dropFileName, ()) -- | Define the type of the backend functions For more purity, instead of -- having each backend writing the generated files to disk, they return a list -- of pairs containing the (relative) file path and the file content. This -- allow for 1) easier testing, 2) implement common options like changing the -- output dir or providing a diff instead of overwritting the files on a -- highter level and 3) more purity. -- -- The writer monad provide a more conveignent api to generate the list. Note -- that we still use the IO monad for now because some backend insist on -- printing stuff to the screen while generating the files. type MkFiles a = WriterT [(FilePath, String)] IO a type Backend = MkFiles () -- | Named after execWriter, this function execute the given backend -- and returns the generated file paths and contents. execBackend :: MkFiles () -> IO [(FilePath, String)] execBackend = execWriterT -- | A specialized version of tell that adds a file and its content to the -- list of generated files mkfile :: FilePath -> String -> MkFiles () mkfile path content = tell [(path,content)] -- | Write a set of files to disk. the first argument is the root directory -- inside which all the generated files will be written. This root directory -- and sub-directories will be created as needed (ex: if the files contains a -- a/b/file.txt, `writeFiles` will create the directories `$ROOT/a` and -- `$ROOT/a/b`) writeFiles :: FilePath -> MkFiles () -> IO () writeFiles root fw = do -- First we check that the directory exists fb <- execBackend fw createDirectoryIfMissing True root mapM_ (uncurry writeFile') fb where writeFile' :: FilePath -> String -> IO () writeFile' path content = createDirectoryIfMissing True (root dropFileName path) >> writeFileRep (root path) content BNFC-2.8.1/src/BNFC/Backend/Haskell.hs0000644000000000000000000003011112654616013015165 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 BNFC.Backend.Haskell (makeHaskell, AlexVersion(..), makefile, testfile) where -- import BNFC.Utils import BNFC.Options hiding (Backend) import BNFC.CF import BNFC.Backend.Base import BNFC.Backend.Haskell.CFtoHappy import BNFC.Backend.Haskell.CFtoAlex import BNFC.Backend.Haskell.CFtoAlex2 import BNFC.Backend.Haskell.CFtoAlex3 import BNFC.Backend.Txt2Tag import BNFC.Backend.Haskell.CFtoAbstract import BNFC.Backend.Haskell.CFtoTemplate import BNFC.Backend.Haskell.CFtoPrinter import BNFC.Backend.Haskell.CFtoLayout import BNFC.Backend.XML import BNFC.Backend.Haskell.HsOpts import BNFC.Backend.Haskell.ToCNF as ToCNF import BNFC.Backend.Haskell.MkErrM import BNFC.Backend.Haskell.MkSharedString import BNFC.Backend.Haskell.Utils (parserName) import qualified BNFC.Backend.Common.Makefile as Makefile import System.FilePath (pathSeparator) import Control.Monad(when,unless) import Text.Printf (printf) import Text.PrettyPrint -- naming conventions makeHaskell :: SharedOptions -> CF -> Backend makeHaskell 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 mkfile (absFile opts) $ cf2Abstract (byteStrings opts) (ghcExtensions opts) (functor opts) absMod cf case alexMode opts of Alex1 -> do mkfile (alexFile opts) $ cf2alex lexMod errMod cf liftIO $ printf "Use Alex 1.1 to compile %s.\n" (alexFile opts) Alex2 -> do mkfile (alexFile opts) $ cf2alex2 lexMod errMod shareMod (shareStrings opts) (byteStrings opts) cf liftIO $ printf "Use Alex 2.0 to compile %s.\n" (alexFile opts) Alex3 -> do mkfile (alexFile opts) $ cf2alex3 lexMod errMod shareMod (shareStrings opts) (byteStrings opts) cf liftIO $ printf "Use Alex 3.0 to compile %s.\n" (alexFile opts) unless (cnf opts) $ do mkfile (happyFile opts) $ cf2HappyS parMod absMod lexMod errMod (glr opts) (byteStrings opts) (functor opts) cf liftIO $ printf "%s Tested with Happy 1.15\n" (happyFile opts) mkfile (tFile opts) $ testfile opts cf mkfile (txtFile opts) $ cfToTxt (lang opts) cf mkfile (templateFile opts) $ cf2Template (templateFileM opts) absMod errMod (functor opts) cf mkfile (printerFile opts) $ cf2Printer (byteStrings opts) (functor opts) False prMod absMod cf when (hasLayout cf) $ mkfile (layoutFile opts) $ cf2Layout (alex1 opts) (inDir opts) layMod lexMod cf mkfile (errFile opts) $ errM errMod cf when (shareStrings opts) $ mkfile (shareFile opts) $ sharedString shareMod (byteStrings opts) cf Makefile.mkMakefile opts $ makefile opts case xml opts of 2 -> makeXML opts True cf 1 -> makeXML opts False cf _ -> return () when (cnf opts) $ do mkfile (cnfTablesFile opts) $ ToCNF.generate opts cf mkfile "TestCNF.hs" $ ToCNF.genTestFile opts cf mkfile "BenchCNF.hs" $ ToCNF.genBenchmark opts 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 ++ [pathSeparator] makeA = Makefile.mkRule "all" [] ([ "happy -gca " ++ glr_params ++ happyFile opts | not (cnf opts) ] ++ [ "alex -g " ++ alexFile opts ] ++ [ if cnf opts then "ghc --make TestCNF.hs" else "ghc --make " ++ tFile opts ++ " -o " ++ mkFile withLang "Test" "" opts]) $ Makefile.mkRule "clean" [] [ "-rm -f " ++ unwords (map (dir++) [ "*.log", "*.aux", "*.hi", "*.o", "*.dvi" ]) ] $ Makefile.mkRule "distclean" ["clean"] [ "-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 , mkFile noLang "ComposOp" "*" 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 render (parserName 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 System.Exit ( exitFailure, exitSuccess )", "", "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 qualified Data.Map(Map, lookup, toList)", 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 runGlr else runStd 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", "", "usage :: IO ()", "usage = do", " putStrLn $ unlines", " [ \"usage: Call with one of the following argument combinations:\"", " , \" --help Display this help message.\"", " , \" (no arguments) Parse stdin verbosely.\"", " , \" (files) Parse content of files verbosely.\"", " , \" -s (files) Silent mode. Parse content of files silently.\"", " ]", " exitFailure", "", "main :: IO ()", "main = do", " args <- getArgs", " case args of", " [\"--help\"] -> usage", " [] -> hGetContents stdin >>= run 2 " ++ firstParser, " \"-s\":fs -> mapM_ (runFile 0 " ++ firstParser ++ ") fs", " fs -> mapM_ (runFile 2 " ++ firstParser ++ ") fs", "", if_glr $ "the_parser :: ParseFun " ++ show topType, if_glr $ "the_parser = lift_parser " ++ render (parserName topType), if_glr "", if_glr liftParser ] runStd 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" , " exitFailure" , " Ok tree -> do putStrLn \"\\nParse Successful!\"" , " showTree v tree" , if xml then " putStrV v $ \"\\n[XML]\\n\\n\" ++ printXML tree" else "" , " exitSuccess" ] runGlr = 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..]" , " ]" ] liftParser = unlines [ "type Forest = Data.Map.Map 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 $ Data.Map.toList f))" , " ParseOK r f -> let find f = fromJust . ((flip Data.Map.lookup) f)" , " dec_fn f = decode (find f) r" , " in GLR_Result (\\ff -> dec_fn $ ff f) (dec_fn f)" ] BNFC-2.8.1/src/BNFC/Backend/XML.hs0000644000000000000000000001745412654616013014261 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 BNFC.Backend.XML ---- (cf2DTD, cf2XML) where import BNFC.CF import BNFC.Utils import BNFC.Backend.Base import BNFC.Options hiding (Backend) import BNFC.Backend.Haskell.CFtoTemplate () import BNFC.Backend.Haskell.HsOpts (xmlFile, xmlFileM, absFileM) import Data.List (intersperse, intercalate) import Data.Char(toLower) import Data.Maybe (fromMaybe) type Coding = Bool ---- change to at least three values makeXML :: SharedOptions -> Coding -> CF -> Backend makeXML opts typ cf = do let name = lang opts mkfile (name ++ ".dtd") $ cf2DTD typ name cf let absmod = "XML" ++ name mkfile (xmlFile opts) $ cf2XMLPrinter typ opts 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 "test" -- "" tag :: String -> String tag s = "<" ++ s ++ ">" element :: String -> [String] -> String 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 -> [(Fun, String)] -> String elemc cat fs = unlines $ element (show cat) (map snd fs) : [element f [] | (f,_) <- fs] elemEmp :: String -> String elemEmp t = elemAtt t "value" [] alts :: [String] -> String 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 (_,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 -> Fun -> [Cat] -> String rhsCat cf fun cs = parenth (intercalate ", " (fun:map (symbCat cf) cs)) rhsCatNot cf cs = if null cs then "EMPTY" else intercalate", " (map (symbCatNot cf) cs) symbCat cf c | isList c = show (normCatOfList c) ++ if isEmptyListCat cf c then "*" else "+" | otherwise = show 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 (show k) ---- parenth s = "(" ++ s ++ ")" -- derive an XML printer from a BNF grammar cf2XMLPrinter :: Bool -> SharedOptions -> String -> CF -> String cf2XMLPrinter typ opts absMod cf = unlines [ prologue typ opts 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 -> SharedOptions -> String -> String prologue b opts _ = unlines [ "module " ++ xmlFileM opts +++ "where\n", "-- pretty-printer generated by the BNF converter\n", "import " ++ absFileM opts, "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 _ t = unlines [ "instance XPrint " ++ t ++ " where", " prt i x = elemTokS i" +++ "\"" ++ t ++ "\"" +++ "x" ] identRule cf = ownPrintRule cf (Cat "Ident") ownPrintRule cf cat = unlines [ "instance XPrint " ++ show cat ++ " where", " prt i (" ++ show cat ++ posn ++ ") = elemTok i" +++ "\"" ++ show cat ++ "\"" +++ "x" ] where posn = if isPositionCat cf cat 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 | x `elem` xs = (x ++ show n) : names xs (n+1) | otherwise = x : names xs n var (ListCat c) = var c ++ "s" var (Cat "Ident") = "id" var (Cat "Integer") = "n" var (Cat "String") = "str" var (Cat "Char") = "c" var (Cat "Double") = "d" var cat = map toLower (show cat) checkRes s | s `elem` 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 = fromMaybe undefined $ lookupRule s (rulesOfCF cf) --- case_fun :: Cat -> [(Constructor,Rule)] -> String case_fun cat xs = unlines [ "instance XPrint" +++ show cat +++ "where", " prt i" +++ "e = case e of", unlines $ map (\ ((c,xx),_) -> " " ++ c +++ unwords xx +++ "-> concat $ " +++ "elemFun i \"" ++ show cat ++ "\" \"" ++ c ++ "\"" +++ unwords [": prt (i+1)" +++ x | x <- xx] +++ ":" +++ "[[replicate (i+i) ' ' ++ endtag \"" ++ c ++ "\" \"" ++ show cat ++ "\"]]" ) xs ] BNFC-2.8.1/src/BNFC/Backend/Latex.hs0000644000000000000000000002676412654616013014702 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 BNFC.Backend.Latex where import AbsBNF (Reg (..)) import BNFC.Options hiding (Backend) import BNFC.Backend.Base import BNFC.Backend.Common.Makefile as Makefile import BNFC.CF import BNFC.Utils import Data.List import System.FilePath ((<.>),replaceExtension) import Text.Printf makeLatex :: SharedOptions -> CF -> Backend makeLatex opts cf = do let texfile = name <.> "tex" mkfile texfile (cfToLatex name cf) Makefile.mkMakefile opts (makefile texfile) where name = lang opts cfToLatex :: String -> CF -> String cfToLatex name cf = unlines [ "\\batchmode", beginDocument name, macros, introduction, prtTerminals name cf, prtBNF name cf, endDocument ] makefile_ = makefile makefile :: String -> String makefile texfile = Makefile.mkRule "all" [pdffile] [] $ Makefile.mkRule pdffile [texfile] [ printf "pdflatex %s" texfile ] $ Makefile.mkRule "clean" [] [ unwords [ "-rm", pdffile, auxfile, logfile ]] $ Makefile.mkRule "cleanall" ["clean"] [ "-rm Makefile " ++ texfile ] "" where pdffile = replaceExtension texfile "pdf" auxfile = replaceExtension texfile "aux" logfile = replaceExtension texfile "log" 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 _ cf = unlines $ map stringLit $ filter (`notElem` [Cat "Ident"]) $ literals cf stringLit :: Cat -> String stringLit cat = unlines $ case cat of Cat "Char" -> ["Character literals \\nonterminal{Char}\\ have the form", "\\terminal{'}$c$\\terminal{'}, where $c$ is any single character.", "" ] Cat "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.", ""] Cat "Integer" -> ["Integer literals \\nonterminal{Int}\\ are nonempty sequences of digits.", ""] Cat "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 [ show 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 = intercalate ", " $ map (symbol.prt) ys mult = intercalate ", " $ 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 ((+++) . p) [] xs where p (Left r) = nonterminal r --- (prt r) p (Right r) = terminal (prt r) prt :: String -> String prt = concatMap escape where escape '\\' = "$\\backslash$" escape '~' = "\\~{}" escape '^' = "{\\textasciicircum}" escape c | c `elem` ("$&%#_{}" :: String) = ['\\', c] escape c | c `elem` ("+=|<>-" :: String) = "{$" ++ [c] ++ "$}" escape c = [c] 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" ++ concatMap (\(a:as) -> foldr (+++) "\\\\\n" (a: map ('&':) as)) xs ++ "\\end{tabular}\\\\\n" terminal :: String -> String terminal s = "{\\terminal{" ++ s ++ "}}" nonterminal :: Cat -> String nonterminal s = "{\\nonterminal{" ++ mkId (identCat 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.8.1/src/BNFC/Backend/C.hs0000644000000000000000000001631112654616013013772 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 BNFC.Backend.C (makeC) where import BNFC.Utils import BNFC.CF import BNFC.Options import BNFC.Backend.Base import BNFC.Backend.C.CFtoCAbs import BNFC.Backend.C.CFtoFlexC import BNFC.Backend.C.CFtoBisonC import BNFC.Backend.C.CFtoCSkel import BNFC.Backend.C.CFtoCPrinter import Data.Char import qualified BNFC.Backend.Common.Makefile as Makefile makeC :: SharedOptions -> CF -> MkFiles () makeC opts cf = do let (hfile, cfile) = cf2CAbs prefix cf mkfile "Absyn.h" hfile mkfile "Absyn.c" cfile let (flex, env) = cf2flex prefix cf mkfile (name ++ ".l") flex let bison = cf2Bison prefix cf env mkfile (name ++ ".y") bison let header = mkHeaderFile cf (allCats cf) (allEntryPoints cf) env mkfile "Parser.h" header let (skelH, skelC) = cf2CSkel cf mkfile "Skeleton.h" skelH mkfile "Skeleton.c" skelC let (prinH, prinC) = cf2CPrinter cf mkfile "Printer.h" prinH mkfile "Printer.c" prinC mkfile "Test.c" (ctest cf) Makefile.mkMakefile opts (makefile name prefix) where prefix :: String -- The prefix is a string used by flex and bison -- that is prepended to generated function names. -- In most cases we want the grammar name as the prefix -- but in a few specific cases, this can create clashes -- with existing functions prefix = if name `elem` ["m","c","re","std","str"] then name ++ "_" else name name = lang opts makefile :: String -> String -> String makefile name prefix = (unlines [ "CC = gcc", "CCFLAGS = -g -W -Wall", "", "FLEX = flex", "FLEX_OPTS = -P" ++ prefix, "", "BISON = bison", "BISON_OPTS = -t -p" ++ prefix, "", "OBJS = Absyn.o Lexer.o Parser.o Printer.o", ""] ++) $ Makefile.mkRule ".PHONY" ["clean", "distclean"] [] $ Makefile.mkRule "all" [testName] [] $ Makefile.mkRule "clean" [] -- peteg: don't nuke what we generated - move that to the "vclean" target. [ "rm -f *.o " ++ testName ++ " " ++ unwords [ name ++ e | e <- [".aux", ".log", ".pdf",".dvi", ".ps", ""]] ] $ Makefile.mkRule "distclean" ["clean"] [ "rm -f " ++ unwords [ "Absyn.h", "Absyn.c", "Test.c", "Parser.c", "Parser.h", "Lexer.c", "Skeleton.c", "Skeleton.h", "Printer.c", "Printer.h", "Makefile " ] ++ name ++ ".l " ++ name ++ ".y " ++ name ++ ".tex "] $ Makefile.mkRule testName ["${OBJS}", "Test.o"] [ "@echo \"Linking " ++ testName ++ "...\"" , "${CC} ${CCFLAGS} ${OBJS} Test.o -o " ++ testName ] $ Makefile.mkRule "Absyn.o" [ "Absyn.c", "Absyn.h"] [ "${CC} ${CCFLAGS} -c Absyn.c" ] $ Makefile.mkRule "Lexer.c" [ name ++ ".l" ] [ "${FLEX} ${FLEX_OPTS} -oLexer.c " ++ name ++ ".l" ] $ Makefile.mkRule "Parser.c" [ name ++ ".y" ] [ "${BISON} ${BISON_OPTS} " ++ name ++ ".y -o Parser.c" ] $ Makefile.mkRule "Lexer.o" [ "Lexer.c", "Parser.h" ] [ "${CC} ${CCFLAGS} -c Lexer.c " ] $ Makefile.mkRule "Parser.o" ["Parser.c", "Absyn.h" ] [ "${CC} ${CCFLAGS} -c Parser.c" ] $ Makefile.mkRule "Printer.o" [ "Printer.c", "Printer.h", "Absyn.h" ] [ "${CC} ${CCFLAGS} -c Printer.c" ] $ Makefile.mkRule "Test.o" [ "Test.c", "Parser.h", "Printer.h", "Absyn.h" ] [ "${CC} ${CCFLAGS} -c Test.c" ] "" where testName = "Test" ++ name -- | Generate a test program that parses stdin and prints the AST and it's -- linearization 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 = show $ 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 catString then ("#define _STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) else mkChar n mkChar n = if isUsedCat cf catChar then ("#define _CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) else mkInteger n mkInteger n = if isUsedCat cf catInteger then ("#define _INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) else mkDouble n mkDouble n = if isUsedCat cf catDouble then ("#define _DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) else mkIdent n mkIdent n = if isUsedCat cf catIdent then ("#define _IDENT_ " ++ show n ++ "\n") else "" mkFunc s | normCat s == s = identCat s ++ " p" ++ identCat s ++ "(FILE *inp);\n" mkFunc _ = "" BNFC-2.8.1/src/BNFC/Backend/Common.hs0000644000000000000000000000237012654616013015040 0ustar0000000000000000module BNFC.Backend.Common (renderListSepByPrecedence) where -- Functions common to different backends import BNFC.PrettyPrint -- | Helper function for c-like languages that generates the code printing -- the list separator according to the given precedence level: -- -- >>> let my_render c = "my_render(\"" <> text c <> "\")" -- >>> renderListSepByPrecedence "x" my_render [] -- -- -- >>> renderListSepByPrecedence "x" my_render [(0,",")] -- my_render(","); -- -- >>> renderListSepByPrecedence "x" my_render [(3,";"), (1, "--")] -- switch(x) -- { -- case 3: my_render(";"); break; -- default: my_render("--"); -- } renderListSepByPrecedence :: Doc -- ^ Name of the coercion level variable -> (String -> Doc) -- ^ render function -> [(Integer, String)] -- ^ separators by precedence -> Doc renderListSepByPrecedence _ _ [] = empty renderListSepByPrecedence _ render [(_,sep)] = render sep <> ";" renderListSepByPrecedence var render ss = "switch(" <> var <> ")" $$ codeblock 2 ( ["case" <+> integer i <:> render sep <>"; break;" | (i, sep) <- init ss] ++ ["default" <:> render sep <>";" | let (_,sep) = last ss]) where a <:> b = a <> ":" <+> b BNFC-2.8.1/src/BNFC/Backend/Utils.hs0000644000000000000000000000125512654616013014711 0ustar0000000000000000-- | Functions that are used in multiple backends module BNFC.Backend.Utils (isTokenType) where import BNFC.CF (Cat(..)) -- | Checks if a category is a token type (either built-in or user-defined) -- The first argument is the list of user-defined token type. -- >>> isTokenType [] (Cat "Integer") -- True -- >>> isTokenType [Cat "Abc"] (Cat "Abc") -- True -- >>> isTokenType [] (Cat "Abc") -- False isTokenType :: [Cat] -> Cat -> Bool isTokenType _ (Cat "Integer") = True isTokenType _ (Cat "Char") = True isTokenType _ (Cat "String") = True isTokenType _ (Cat "Double") = True isTokenType _ (Cat "Ident") = True isTokenType user cat | cat `elem` user = True isTokenType _ _ = False BNFC-2.8.1/src/BNFC/Backend/HaskellProfile.hs0000644000000000000000000002061512654616013016516 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 BNFC.Backend.HaskellProfile (makeHaskellProfile) where import Control.Monad (when) import Data.Maybe (isJust) import BNFC.CF import BNFC.Options hiding (Backend) import BNFC.Backend.Base import BNFC.Backend.HaskellProfile.CFtoHappyProfile import BNFC.Backend.Haskell.CFtoAlex import BNFC.Backend.Haskell.CFtoAlex2 import BNFC.Backend.Haskell.MkErrM -- 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 absFileM, alexFile, alexFileM, happyFile, happyFileM, errFile, errFileM, tFile, mFile :: Bool -> String -> FilePath absFileM = nameMod "Abs" alexFile = nameFile "Lex" "x" alexFileM = nameMod "Lex" happyFile = nameFile "Par" "y" happyFileM = nameMod "Par" tFile = nameFile "Test" "hs" 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" makeHaskellProfile :: SharedOptions -> CFP -> Backend makeHaskellProfile opts cfp = do let absMod = absFileM (inDir opts) name lexMod = alexFileM (inDir opts) name parMod = happyFileM (inDir opts) name errMod = errFileM (inDir opts) name let cf = cfp2cf cfp do ---- mkfile (absFile (inDir opts) name) $ cf2Abstract (absFileM (inDir opts) name) cf if alexMode opts == Alex1 then do mkfile (alexFile (inDir opts) name) $ cf2alex lexMod errMod cf liftIO $ putStrLn " (Use Alex 1.1 to compile.)" else do mkfile (alexFile (inDir opts) name) $ cf2alex2 lexMod errMod "" False False cf liftIO $ putStrLn " (Use Alex 2.0 to compile.)" mkfile (happyFile (inDir opts) name) $ cf2HappyProfileS parMod absMod lexMod errMod cfp liftIO $ putStrLn " (Tested with Happy 1.13)" ---- mkfile (templateFile (inDir opts) name) $ ---- cf2Template tplMod absMod errMod cf ---- mkfile (printerFile (inDir opts) name) $ cf2Printer prMod absMod cf ---- if hasLayout cf then ---- mkfile (layoutFile (inDir opts) name) $ cf2Layout alex1 (inDir opts) layMod lexMod cf ---- else return () mkfile (tFile (inDir opts) name) $ testfile (inDir opts) name (xml opts>0) cf mkfile (errFile (inDir opts) name) $ errM errMod cf when (isJust $ make opts) (mkfile (mFile (inDir opts) name) $ makefile (inDir opts) name) ---- case xml of ---- 2 -> makeXML name True cf ---- 1 -> makeXML name False cf ---- _ -> return () where name = lang opts 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', '\t' : if inDir then "(" ++ "cd ..; " ++ ghcCommand ++ ")" else ghcCommand, "clean:", "\t rm -f *.hi *.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 _ cf = makeA where makeA = let lay = hasLayout cf 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 System.Exit ( exitFailure )", "", "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", "", "usage :: IO ()", "usage = do", " putStrLn $ unlines", " [ \"usage: Call with one of the following argument combinations:\"", " , \" --help Display this help message.\"", " , \" (no arguments) Parse stdin.\"", " , \" (file) Parse content of file.\"", " ]", " exitFailure", "", "main :: IO ()", "main = do", " args <- getArgs", " case args of", " [\"--help\"] -> usage", " [] -> hGetContents stdin >>= run " ++ firstParser, " [f] -> runFile " ++ firstParser ++ " f", " _ -> do progName <- getProgName", " putStrLn $ progName ++ \": excess arguments.\"" ] where firstParser = 'p' : show (firstEntry cf) BNFC-2.8.1/src/BNFC/Backend/Pygments.hs0000644000000000000000000001152012654616013015413 0ustar0000000000000000{- Generates a Pygments lexer from a BNF grammar. - - Resources: - * Pygments: http://pygments.org/ - * Lexer development: http://pygments.org/docs/lexerdevelopment/ - * Token types: http://pygments.org/docs/tokens/ - -} module BNFC.Backend.Pygments where import AbsBNF (Reg(..)) import BNFC.Backend.Base (mkfile, Backend) import BNFC.CF import BNFC.Lexing import BNFC.Options hiding (Backend) import BNFC.Utils import BNFC.PrettyPrint makePygments :: SharedOptions -> CF -> Backend makePygments opts cf = do let lexerfile = render (lowerCase name <> "/__init__.py") setupfile = "setup.py" mkfile lexerfile (render $ lexer name cf) mkfile setupfile (render $ setup name) where name = lang opts setup :: String -> Doc setup name = vcat [ "from setuptools import setup, find_packages" , "setup" <> parens (fsep (punctuate "," [ "name" <=> quotes ("pygment-"<>lowerCase name) , "version" <=> "0.1" , "packages" <=> brackets (quotes moduleName) , "entry_points" <=> entryPoints , "install_requires = ['pygments']" ])) ] where className = camelCase name <> "Lexer" moduleName = lowerCase name entryPoints = braces( "'pygments.lexers':" <> doubleQuotes (moduleName <> "=" <> moduleName <> ":" <> className)) lexer :: String -> CF -> Doc lexer name cf = vcat -- Import statments [ "import pygments.lexer" , "from pygments.token import *" -- Declare our lexer , "__all__" <=> brackets (doubleQuotes className) -- define lexer , "class" <+> className <> parens "pygments.lexer.RegexLexer" <> ":" , indent [ "name" <=> quotes (text name) , "aliases" <=> brackets (quotes (lowerCase name)) -- filenames = ['*.cf', '*lbnf'] , "KEYWORDS" <=> brackets keywords -- We override the get_tokens_unprocessed method to filter keywords -- from identifiers , "def get_tokens_unprocessed(self, text):" , indent [ "for index, token, value in super(" <> className <> ",self).get_tokens_unprocessed(text):" , indent [ "if token is Name and value in self.KEYWORDS:" , indent [ "yield index, Keyword, value" ] , "else:" , indent [ "yield index, token, value" ] ] ] -- The token is defined using regex , "tokens = {" , indent [ "'root': [" , indent (map prLexRule (mkLexer cf) ++ ["(r'\\s+', Token.Space)"]) , "]" ] , "}" ] ] where className = camelCase name <> "Lexer" keywords = fsep (punctuate "," (map (quotes . text) (reservedWords cf))) indent = nest 4 . vcat prLexRule (reg,ltype) = parens ("r" <> quotes (pyRegex reg) <> "," <+> pyToken ltype) <> "," pyToken LexComment = "Comment" pyToken LexSymbols = "Operator" pyToken (LexToken "Integer") = "Number.Integer" pyToken (LexToken "Double") = "Number.Float" pyToken (LexToken "Char") = "String.Char" pyToken (LexToken "String") = "String.Double" pyToken (LexToken _) = "Name" -- | Convert a Reg to a python regex -- >>> pyRegex (RSeqs "abc") -- abc -- >>> pyRegex (RAlt (RSeqs "::=") (RChar '.')) -- ::=|\. -- >>> pyRegex (RChar '=') -- = -- >>> pyRegex RAny -- . -- >>> pyRegex (RStar RAny) -- .* -- >>> pyRegex (RPlus (RSeqs "xxx")) -- (xxx)+ -- >>> pyRegex (ROpt (RSeqs "abc")) -- (abc)? -- >>> pyRegex (RSeq (RSeqs "--") (RSeq (RStar RAny) (RChar '\n'))) -- --.*\n -- >>> pyRegex (RStar (RSeq (RSeqs "abc") (RChar '*'))) -- (abc\*)* -- >>> pyRegex REps -- -- >>> pyRegex (RAlts "abc[].") -- [abc\[\]\.] -- >>> pyRegex RDigit -- \d -- >>> pyRegex RLetter -- [a-zA-Z] -- >>> pyRegex RUpper -- [A-Z] -- >>> pyRegex RLower -- [a-z] -- >>> pyRegex (RMinus RAny RDigit) -- (.)(?>> pyRegex (RSeq (RAlt (RChar 'a') RAny) (RAlt (RChar 'b') (RChar 'c'))) -- (a|.)(b|c) pyRegex :: Reg -> Doc pyRegex reg = case reg of RSeqs s -> text (concatMap escape s) RAlt r1 r2 -> pyRegex r1 <> "|" <> pyRegex r2 RChar c -> text (escape c) RAny -> char '.' RStar RAny -> ".*" RStar re -> parens (pyRegex re) <> char '*' RPlus re -> parens (pyRegex re) <> char '+' ROpt re -> parens (pyRegex re) <> char '?' RSeq r1 r2 -> pyRegex' r1 <> pyRegex' r2 REps -> empty RAlts cs -> brackets (hcat (map (pyRegex . RChar) cs)) RDigit -> "\\d" RUpper -> "[A-Z]" RLower -> "[a-z]" RLetter -> "[a-zA-Z]" RMinus r1 r2 -> parens (pyRegex r1) <> parens ("? pyRegex r2) where escape '\n' = "\\n" escape '\t' = "\\t" escape c | c `elem` (".'[]()|*+?{}\\" :: String) = ['\\',c] escape c = [c] pyRegex' r@(RAlt{}) = parens (pyRegex r) pyRegex' r = pyRegex r BNFC-2.8.1/src/BNFC/Backend/Java.hs0000644000000000000000000002570012654616013014473 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 BNFC.Backend.Java ( makeJava ) where ------------------------------------------------------------------- -- Dependencies. ------------------------------------------------------------------- import System.FilePath (pathSeparator) import BNFC.Utils import BNFC.CF import BNFC.Options as Options import BNFC.Backend.Base import BNFC.Backend.Java.CFtoCup15 ( cf2Cup ) import BNFC.Backend.Java.CFtoJLex15 import BNFC.Backend.Java.CFtoJavaAbs15 ( cf2JavaAbs ) import BNFC.Backend.Java.CFtoJavaPrinter15 import BNFC.Backend.Java.CFtoVisitSkel15 import BNFC.Backend.Java.CFtoComposVisitor import BNFC.Backend.Java.CFtoAbstractVisitor import BNFC.Backend.Java.CFtoFoldVisitor import BNFC.Backend.Java.CFtoAllVisitor import qualified BNFC.Backend.Common.Makefile as Makefile import BNFC.PrettyPrint ------------------------------------------------------------------- -- | Build the Java output. -- FIXME: get everything to put the files in the right places. -- Adapt Makefile to do the business. ------------------------------------------------------------------- makeJava :: SharedOptions -> CF -> MkFiles () makeJava options@Options{..} cf = do -- Create the package directories if necessary. let packageBase = case inPackage of Nothing -> lang Just p -> p ++ "." ++ lang packageAbsyn = packageBase ++ "." ++ "Absyn" dirBase = pkgToDir packageBase dirAbsyn = pkgToDir packageAbsyn let absynFiles = remDups $ cf2JavaAbs packageBase packageAbsyn cf absynBaseNames = map fst absynFiles absynFileNames = map (dirAbsyn ++) absynBaseNames let writeAbsyn (filename, contents) = mkfile (dirAbsyn ++ filename ++ ".java") contents mapM_ writeAbsyn absynFiles mkfile (dirBase ++ "PrettyPrinter.java") $ cf2JavaPrinter packageBase packageAbsyn cf mkfile (dirBase ++ "VisitSkel.java") $ cf2VisitSkel packageBase packageAbsyn cf mkfile (dirBase ++ "ComposVisitor.java") $ cf2ComposVisitor packageBase packageAbsyn cf mkfile (dirBase ++ "AbstractVisitor.java") $ cf2AbstractVisitor packageBase packageAbsyn cf mkfile (dirBase ++ "FoldVisitor.java") $ cf2FoldVisitor packageBase packageAbsyn cf mkfile (dirBase ++ "AllVisitor.java") $ cf2AllVisitor packageBase packageAbsyn cf mkfile (dirBase ++ "Test.java") $ render $ javaTest packageBase packageAbsyn cf --- mkfile ("Test" ++ name) $ "java " ++ dirBase ++ "Test $(1)" let (lex, env) = cf2jlex packageBase cf jflex mkfile (dirBase ++ "Yylex") (render lex) liftIO $ putStrLn " (Tested with JLex 1.2.6.)" mkfile (dirBase ++ lang ++ ".cup") $ cf2Cup packageBase packageAbsyn cf env -- FIXME: put in a doc directory? liftIO $ putStrLn $ " (Parser created for category " ++ show (firstEntry cf) ++ ")" liftIO $ putStrLn " (Tested with CUP 0.10k)" Makefile.mkMakefile options $ makefile lang dirBase dirAbsyn absynFileNames jflex 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 '.' pathSeparator s ++ [pathSeparator] -- 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] -> Bool -> String makefile name dirBase dirAbsyn absynFileNames jflex = Makefile.mkVar "JAVAC" "javac" $ Makefile.mkVar "JAVAC_FLAGS" "-sourcepath ." $ Makefile.mkVar "JAVA" "java" $ Makefile.mkVar "JAVA_FLAGS" "" $ Makefile.mkVar "CUP" "java_cup.Main" $ Makefile.mkVar "CUPFLAGS" "-nopositions -expect 100" $ (if jflex then Makefile.mkVar "JFLEX" "jflex" else Makefile.mkVar "JLEX" "JLex.Main" ) $ Makefile.mkRule "all" [ "test" ] [] $ Makefile.mkRule "test" ("absyn" : map (dirBase ++) [ "Yylex.class", "PrettyPrinter.class", "Test.class", "ComposVisitor.class", "AbstractVisitor.class", "FoldVisitor.class", "AllVisitor.class", "parser.class", "sym.class", "Test.class"]) [] $ Makefile.mkRule ".PHONY" ["absyn"] [] $ Makefile.mkRule "%.class" [ "%.java" ] [ "${JAVAC} ${JAVAC_FLAGS} $^" ] $ Makefile.mkRule "absyn" [absynJavaSrc] [ "${JAVAC} ${JAVAC_FLAGS} $^" ] $ Makefile.mkRule (dirBase ++ "Yylex.java") [ dirBase ++ "Yylex" ] [ (if jflex then "${JFLEX} " else "${JAVA} ${JAVA_FLAGS} ${JLEX} ") ++ dirBase ++ "Yylex" ] $ Makefile.mkRule (dirBase ++ "sym.java " ++ dirBase ++ "parser.java") [ dirBase ++ name ++ ".cup" ] [ "${JAVA} ${JAVA_FLAGS} ${CUP} ${CUPFLAGS} " ++ dirBase ++ name ++ ".cup" , "mv sym.java parser.java " ++ dirBase ] $ Makefile.mkRule (dirBase ++ "Yylex.class") [ dirBase ++ "Yylex.java", dirBase ++ "sym.java" ] [] $ Makefile.mkRule (dirBase ++ "sym.class") [ dirBase ++ "sym.java" ] [] $ Makefile.mkRule (dirBase ++ "parser.class") [ dirBase ++ "parser.java" , dirBase ++ "sym.java" ] [] $ Makefile.mkRule (dirBase ++ "PrettyPrinter.class") [ dirBase ++ "PrettyPrinter.java" ] [] -- FIXME $ Makefile.mkRule "clean" [] [ "rm -f " ++ dirAbsyn ++ "*.class" ++ " " ++ dirBase ++ "*.class" ] $ Makefile.mkRule "distclean" [ "vclean" ] [] $ Makefile.mkRule "vclean" [] [ " rm -f " ++ absynJavaSrc ++ " " ++ absynJavaClass , " rm -f " ++ dirAbsyn ++ "*.class" -- , "rm -f " ++ "Test" ++ name , " rmdir " ++ dirAbsyn , " 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"]) , "rm -f Makefile" , "rmdir -p " ++ dirBase ] "" where absynJavaSrc = unwords (map (++ ".java") absynFileNames) absynJavaClass = unwords (map (++ ".class") absynFileNames) javaTest :: String -> String -> CF -> Doc javaTest packageBase packageAbsyn cf = vcat [ "package" <+> text packageBase <> ";" , "import java_cup.runtime.*;" , "import" <+> text packageBase <> ".*;" , "import" <+> text packageAbsyn <> ".*;" , "import java.io.*;" , "" , "public class Test" , codeblock 2 [ "public static void main(String args[]) throws Exception" , codeblock 2 [ "Yylex l = null;" , "parser p;" , "try" , codeblock 2 [ "if (args.length == 0) l = new Yylex(new InputStreamReader(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: */" , "/* " <> fsep (punctuate "," (showOpts (tail eps))) <> " */" , "try" , "{" , " " <> text packageAbsyn <> "." <> text (show def) <+> "parse_tree = p.p" <> text (show 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:xs) | normCat x /= x = showOpts xs | otherwise = text ('p' : identCat x) : showOpts xs BNFC-2.8.1/src/BNFC/Backend/CPP/0000755000000000000000000000000012654616013013674 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/CPP/NoSTL.hs0000644000000000000000000001542212654616013015173 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 BNFC.Backend.CPP.NoSTL (makeCppNoStl) where import BNFC.Utils import BNFC.CF import BNFC.Options import BNFC.Backend.Base import BNFC.Backend.CPP.NoSTL.CFtoCPPAbs import BNFC.Backend.CPP.NoSTL.CFtoFlex import BNFC.Backend.CPP.NoSTL.CFtoBison import BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel import BNFC.Backend.CPP.PrettyPrinter import Data.Char import qualified BNFC.Backend.Common.Makefile as Makefile makeCppNoStl :: SharedOptions -> CF -> MkFiles () makeCppNoStl opts cf = do let (hfile, cfile) = cf2CPPAbs name cf mkfile "Absyn.H" hfile mkfile "Absyn.C" cfile let (flex, env) = cf2flex Nothing name cf mkfile (name ++ ".l") flex let bison = cf2Bison name cf env mkfile (name ++ ".y") bison let header = mkHeaderFile cf (allCats cf) (allEntryPoints cf) env mkfile "Parser.H" header let (skelH, skelC) = cf2CVisitSkel cf mkfile "Skeleton.H" skelH mkfile "Skeleton.C" skelC let (prinH, prinC) = cf2CPPPrinter False Nothing cf mkfile "Printer.H" prinH mkfile "Printer.C" prinC mkfile "Test.C" (cpptest cf) Makefile.mkMakefile opts $ makefile name where name = lang opts makefile :: String -> String makefile name = (unlines [ "CC = g++", "CCFLAGS = -g -W -Wall", "", "FLEX = flex", "FLEX_OPTS = -P" ++ name, "", "BISON = bison", "BISON_OPTS = -t -p" ++ name, "", "OBJS = Absyn.o Lexer.o Parser.o Printer.o", "" ] ++) $ Makefile.mkRule ".PHONY" ["clean", "distclean"] [] $ Makefile.mkRule "all" [testName] [] $ Makefile.mkRule "clean" [] -- peteg: don't nuke what we generated - move that to the "vclean" target. [ "rm -f *.o " ++ testName ++ " " ++ unwords [ name ++ e | e <- [".aux", ".log", ".pdf",".dvi", ".ps", ""]] ] $ Makefile.mkRule "distclean" ["clean"] [ "rm -f " ++ unwords [ "Absyn.C", "Absyn.H", "Test.C", "Parser.C", "Parser.H", "Lexer.C", "Skeleton.C", "Skeleton.H", "Printer.C", "Printer.H", "Makefile " ] ++ name ++ ".l " ++ name ++ ".y " ++ name ++ ".tex "] $ Makefile.mkRule (testName) [ "${OBJS}", "Test.o" ] [ "@echo \"Linking " ++ testName ++ "...\"" , "${CC} ${CCFLAGS} ${OBJS} Test.o -o " ++ testName ] $ Makefile.mkRule "Absyn.o" [ "Absyn.C", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Absyn.C" ] $ Makefile.mkRule "Lexer.C" [ name ++ ".l" ] [ "${FLEX} -oLexer.C " ++ name ++ ".l" ] $ Makefile.mkRule "Parser.C" [ name ++ ".y" ] [ "${BISON} " ++ name ++ ".y -o Parser.C" ] $ Makefile.mkRule "Lexer.o" [ "Lexer.C", "Parser.H" ] [ "${CC} ${CCFLAGS} -c Lexer.C " ] $ Makefile.mkRule "Parser.o" [ "Parser.C", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Parser.C" ] $ Makefile.mkRule "Printer.o" [ "Printer.C", "Printer.H", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Printer.C" ] $ Makefile.mkRule "Test.o" [ "Test.C", "Parser.H", "Printer.H", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Test.C" ] "" where testName = "Test" ++ name 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 = show (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 catString then ("#define _STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) else mkChar n mkChar n = if isUsedCat cf catChar then ("#define _CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) else mkInteger n mkInteger n = if isUsedCat cf catInteger then ("#define _INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) else mkDouble n mkDouble n = if isUsedCat cf catDouble then ("#define _DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) else mkIdent n mkIdent n = if isUsedCat cf catIdent then ("#define _IDENT_ " ++ show n ++ "\n") else "" mkFunc s | (normCat s == s) = (identCat s) ++ "*" +++ "p" ++ (identCat s) ++ "(FILE *inp);\n" mkFunc _ = "" BNFC-2.8.1/src/BNFC/Backend/CPP/STL.hs0000644000000000000000000001736012654616013014701 0ustar0000000000000000{- BNF Converter: C++ Main file Copyright (C) 2004 Author: Markus Forsberg, Michael Pellauer Modified from CPPTop to BNFC.Backend.CPP.STL 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 BNFC.Backend.CPP.STL (makeCppStl,) where import BNFC.Utils import BNFC.CF import BNFC.Options import BNFC.Backend.Base import BNFC.Backend.CPP.STL.CFtoSTLAbs import BNFC.Backend.CPP.NoSTL.CFtoFlex import BNFC.Backend.CPP.STL.CFtoBisonSTL import BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL import BNFC.Backend.CPP.PrettyPrinter import BNFC.Backend.CPP.STL.STLUtils import Data.Char import qualified BNFC.Backend.Common.Makefile as Makefile makeCppStl :: SharedOptions -> CF -> MkFiles () makeCppStl opts cf = do let (hfile, cfile) = cf2CPPAbs (linenumbers opts) (inPackage opts) name cf mkfile "Absyn.H" hfile mkfile "Absyn.C" cfile let (flex, env) = cf2flex (inPackage opts) name cf mkfile (name ++ ".l") flex let bison = cf2Bison (linenumbers opts) (inPackage opts) name cf env mkfile (name ++ ".y") bison let header = mkHeaderFile (inPackage opts) cf (allCats cf) (allEntryPoints cf) env mkfile "Parser.H" header let (skelH, skelC) = cf2CVisitSkel (inPackage opts) cf mkfile "Skeleton.H" skelH mkfile "Skeleton.C" skelC let (prinH, prinC) = cf2CPPPrinter True (inPackage opts) cf mkfile "Printer.H" prinH mkfile "Printer.C" prinC mkfile "Test.C" (cpptest (inPackage opts) cf) Makefile.mkMakefile opts $ makefile name where name = lang opts makefile :: String -> String makefile name = (unlines [ "CC = g++", "CCFLAGS = -g -W -Wall", "", "FLEX = flex", "FLEX_OPTS = -P" ++ name, "", "BISON = bison", "BISON_OPTS = -t -p" ++ name, "", "OBJS = Absyn.o Lexer.o Parser.o Printer.o", "" ] ++) $ Makefile.mkRule ".PHONY" ["clean", "distclean"] [] $ Makefile.mkRule "all" [testName] [] $ Makefile.mkRule "clean" [] -- peteg: don't nuke what we generated - move that to the "vclean" target. [ "rm -f *.o " ++ testName ++ " " ++ unwords [ name ++ e | e <- [".aux", ".log", ".pdf",".dvi", ".ps", ""]] ] $ Makefile.mkRule "distclean" ["clean"] [ "rm -f " ++ unwords [ "Absyn.C", "Absyn.H", "Test.C", "Parser.C", "Parser.H", "Lexer.C", "Skeleton.C", "Skeleton.H", "Printer.C", "Printer.H", "Makefile " ] ++ name ++ ".l " ++ name ++ ".y " ++ name ++ ".tex "] $ Makefile.mkRule (testName) [ "${OBJS}", "Test.o" ] [ "@echo \"Linking " ++ testName ++ "...\"" , "${CC} ${CCFLAGS} ${OBJS} Test.o -o " ++ testName ] $ Makefile.mkRule "Absyn.o" [ "Absyn.C", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Absyn.C" ] $ Makefile.mkRule "Lexer.C" [ name ++ ".l" ] [ "${FLEX} -oLexer.C " ++ name ++ ".l" ] $ Makefile.mkRule "Parser.C" [ name ++ ".y" ] [ "${BISON} " ++ name ++ ".y -o Parser.C" ] $ Makefile.mkRule "Lexer.o" [ "Lexer.C", "Parser.H" ] [ "${CC} ${CCFLAGS} -c Lexer.C" ] $ Makefile.mkRule "Parser.o" [ "Parser.C", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Parser.C" ] $ Makefile.mkRule "Printer.o" [ "Printer.C", "Printer.H", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Printer.C" ] $ Makefile.mkRule "Skeleton.o" [ "Skeleton.C", "Skeleton.H", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Skeleton.C" ] $ Makefile.mkRule "Test.o" [ "Test.C", "Parser.H", "Printer.H", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Test.C" ] "" where testName = "Test" ++ name 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 = show (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 catString then ("#define " ++ nsDefine inPackage "_STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) else mkChar n mkChar n = if isUsedCat cf catChar then ("#define " ++ nsDefine inPackage "_CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) else mkInteger n mkInteger n = if isUsedCat cf catInteger then ("#define " ++ nsDefine inPackage "_INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) else mkDouble n mkDouble n = if isUsedCat cf catDouble then ("#define " ++ nsDefine inPackage "_DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) else mkIdent n mkIdent n = if isUsedCat cf catIdent 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.8.1/src/BNFC/Backend/CPP/PrettyPrinter.hs0000644000000000000000000005125712654616013017075 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 BNFC.Backend.CPP.PrettyPrinter (cf2CPPPrinter, prRender) where import BNFC.CF import BNFC.Utils ((+++)) import BNFC.Backend.Common import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Common.StrUtils (renderCharOrString) import Data.Char(toLower) import BNFC.Backend.CPP.STL.STLUtils import BNFC.PrettyPrint --Produces (.H file, .C file) cf2CPPPrinter :: Bool -> Maybe String -> CF -> (String, String) cf2CPPPrinter useStl inPackage cf = (mkHFile useStl inPackage cf groups, mkCFile useStl inPackage cf groups) where groups = positionRules cf ++ fixCoercions (ruleGroupsInternals cf) positionRules :: CF -> [(Cat,[Rule])] positionRules cf = [(cat,[Rule (show cat) cat [Left catString, Left catInteger]]) | cat <- filter (isPositionCat cf) $ fst (unzip (tokenPragmas cf))] {- **** Header (.H) File Methods **** -} --An extremely large function to make the Header File mkHFile :: Bool -> Maybe String -> CF -> [(Cat,[Rule])] -> String mkHFile useStl 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);", if useStl then "void render(char* s);" else "", " 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;", " }", if useStl then render (nest 2 bufAppendString) else "", " 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;", "};", "" ] bufAppendString :: Doc bufAppendString = "void inline bufAppend(String str)" $$ codeblock 2 [ "const char* s = str.c_str();" , "bufAppend(s);"] 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 isList cat then concat [" void visit", cl, "(", cl, "* p);\n"] else abstract ++ concatMap prRuleH rules where cl = identCat (normCat cat) abstract = case lookupRule (show cat) rules of Just _ -> "" Nothing -> " void visit" ++ cl ++ "(" ++ cl ++ " *p); /* abstract class */\n" --Prints all the methods to visit a rule. prRuleH :: Rule -> String prRuleH (Rule fun _ _) | isProperLabel fun = concat [" void visit", fun, "(", fun, " *p);\n"] prRuleH _ = "" {- **** Implementation (.C) File Methods **** -} --This makes the .C file by a similar method. mkCFile :: Bool -> Maybe String -> CF -> [(Cat,[Rule])] -> String mkCFile useStl inPackage cf groups = concat [ header, nsStart inPackage ++ "\n", prRender useStl, printEntries, concatMap (prPrintData useStl inPackage cf) groups, printBasics, printTokens, showEntries, concatMap (prShowData useStl) groups, showBasics, showTokens, nsEnd inPackage ++ "\n" ] where header = unlines [ "/*** BNFC-Generated Pretty Printer and Abstract Syntax Viewer ***/", "", "#include ", "#include \"Printer.H\"", "#define INDENT_WIDTH 2", "" ] 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);", "}", "" ] printTokens = unlines [unlines [ "void PrintAbsyn::visit" ++ t ++ "(String s)", "{", " 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)", "{", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "void ShowAbsyn::visitIdent(String s)", "{", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "" ] showTokens = unlines [unlines [ "void ShowAbsyn::visit" ++ t ++ "(String s)", "{", " bufAppend('\\\"');", " bufAppend(s);", " bufAppend('\\\"');", "}", "" ] | t <- tokenNames cf ] {- **** Pretty Printer Methods **** -} --Generates methods for the Pretty Printer prPrintData :: Bool -> Maybe String -> CF -> (Cat, [Rule]) -> String prPrintData True {- use STL -} _ _ (cat@(ListCat _), rules) = render $ genPrintVisitorList (cat, rules) prPrintData False {- use STL -} _ _ (cat@(ListCat _), rules) = genPrintVisitorListNoStl (cat, rules) prPrintData _ inPackage cf (cat, rules) = -- Not a list -- a position token if isPositionCat cf cat then unlines [ "void PrintAbsyn::visit" ++ show cat ++ "(" ++ show cat ++ "* p)", "{", " visitIdent(p->string_);", "}" ] else abstract ++ concatMap (prPrintRule inPackage) rules where cl = identCat (normCat cat) abstract = case lookupRule (show cat) rules of Just _ -> "" Nothing -> "void PrintAbsyn::visit" ++ cl ++ "(" ++ cl ++ "*p) {} //abstract class\n\n" -- | Generate pretty printer visitor for a list category: -- -- >>> let c = Cat "C" ; lc = ListCat c -- >>> let rules = [Rule "[]" lc [], Rule "(:)" lc [Left c, Right "-", Left lc]] -- >>> genPrintVisitorList (lc, rules) -- void PrintAbsyn::visitListC(ListC *listc) -- { -- for (ListC::const_iterator i = listc->begin() ; i != listc->end() ; ++i) -- { -- (*i)->accept(this); -- render('-'); -- } -- } -- -- >>> let c2 = CoercCat "C" 2 ; lc2 = ListCat c2 -- >>> let rules2 = rules ++ [Rule "[]" lc2 [], Rule "(:)" lc2 [Left c2, Right "+", Left lc2]] -- >>> genPrintVisitorList (lc, rules2) -- void PrintAbsyn::visitListC(ListC *listc) -- { -- for (ListC::const_iterator i = listc->begin() ; i != listc->end() ; ++i) -- { -- (*i)->accept(this); -- switch(_i_) -- { -- case 2: render('+'); break; -- default: render('-'); -- } -- } -- } genPrintVisitorList :: (Cat, [Rule]) -> Doc genPrintVisitorList (cat@(ListCat c), rules) = "void PrintAbsyn::visit" <> text cl <> "("<> text cl <> " *" <> vname <> ")" $$ codeblock 2 [ "for ("<> text cl <> "::const_iterator i = " <> vname <> "->begin() ; i != " <> vname <> "->end() ; ++i)" , codeblock 2 [ if isTokenCat c then "visit" <> text (baseName cl) <> "(*i) ;" else "(*i)->accept(this);" , (if hasOneFunc rules then "if (i != " <> vname <> "->end() - 1)" else empty) <+> renderListSepByPrecedence "_i_" renderSep separators ] ] where separators = getSeparatorByPrecedence rules cl = identCat (normCat cat) vname = text $ map toLower cl renderSep s = "render(" <> text (snd (renderCharOrString s)) <> ")" genPrintVisitorList _ = error "genPrintVisitorList expects a ListCat" -- | This is the only part of the pretty printer that differs significantly -- between the versions with and without STL. genPrintVisitorListNoStl :: (Cat, [Rule]) -> String genPrintVisitorListNoStl (cat@(ListCat c), rules) = unlines [ "void PrintAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")" , "{" , " while(" ++ vname ++ "!= 0)" , " {" , " if (" ++ vname ++ "->" ++ vname ++ "_ == 0)" , " {" , visitMember , optsep , " " ++ vname +++ "= 0;" , " }" , " else" , " {" , visitMember , render $ nest 6 $ renderListSepByPrecedence "_i_" renderSep separators , " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;" , " }" , " }" , "}" , "" ] where visitMember = if isTokenCat c then " visit" ++ funName c ++ "(" ++ vname ++ "->" ++ member ++ ");" else " " ++ vname ++ "->" ++ member ++ "->accept(this);" cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl ++ "_" optsep = if hasOneFunc rules then "" else " render(" ++ sep ++ ");" sep = snd (renderCharOrString sep') sep' = getCons rules renderSep s = "render(" <> text (snd (renderCharOrString s)) <> ")" separators = getSeparatorByPrecedence rules genPrintVisitorListNoStl _ = error "genPrintVisitorListNoStl expects a ListCat" --Pretty Printer methods for a rule. prPrintRule :: Maybe String -> Rule -> String prPrintRule inPackage r@(Rule fun _ 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 fnm) (numVars cats) fnm = "p" --old names could cause conflicts prPrintRule _ _ = "" --This goes on to recurse to the instance variables. prPrintCat :: String -> Either (Cat, Doc) String -> String prPrintCat _ (Right t) = " render(" ++ t' ++ ");\n" where t' = snd (renderCharOrString t) prPrintCat fnm (Left (c, nt)) | isTokenCat c = " visit" ++ funName c ++ "(" ++ fnm ++ "->" ++ render nt ++ ");\n" | isList c = " if(" ++ fnm ++ "->" ++ render nt ++ ") {" ++ accept ++ "}" | otherwise = " " ++ accept ++ "\n" where accept | c == InternalCat = "/* Internal Category */\n" | otherwise = setI (precCat c) ++ fnm ++ "->" ++ render nt ++ "->accept(this);" {- **** Abstract Syntax Tree Printer **** -} --This prints the functions for Abstract Syntax tree printing. prShowData :: Bool -> (Cat, [Rule]) -> String prShowData True (cat@(ListCat c), _) = unlines [ "void ShowAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")", "{", " for ("++ cl ++"::const_iterator i = " ++ vname++"->begin() ; i != " ++vname ++"->end() ; ++i)", " {", if isTokenCat c then " visit" ++ baseName cl ++ "(*i) ;" else " (*i)->accept(this);", " if (i != " ++ vname ++ "->end() - 1) bufAppend(\", \");", " }", "}", "" ] where cl = identCat (normCat cat) vname = map toLower cl prShowData False (cat@(ListCat c), _) = unlines [ "void ShowAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")", "{", " while(" ++ vname ++ "!= 0)", " {", " if (" ++ vname ++ "->" ++ vname ++ "_)", " {", visitMember, " bufAppend(\", \");", " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", " else", " {", visitMember, " " ++ vname ++ " = 0;", " }", " }", "}", "" ] where cl = identCat (normCat cat) ecl = identCat (normCatOfList cat) vname = map toLower cl member = map toLower ecl ++ "_" visitMember = if isTokenCat c then " visit" ++ funName c ++ "(" ++ vname ++ "->" ++ member ++ ");" else " " ++ vname ++ "->" ++ member ++ "->accept(this);" prShowData _ (cat, rules) = --Not a list: abstract ++ concatMap prShowRule rules where cl = identCat (normCat cat) abstract = case lookupRule (show cat) rules of Just _ -> "" Nothing -> "void ShowAbsyn::visit" ++ cl ++ "(" ++ cl ++ "* p) {} //abstract class\n\n" --This prints all the methods for Abstract Syntax tree rules. prShowRule :: Rule -> String prShowRule (Rule fun _ 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 fnm) (numVars cats))) insertSpaces [] = [] insertSpaces (x:[]) = [x] insertSpaces (x:xs) = if x == "" then insertSpaces xs else x : " bufAppend(' ');\n" : insertSpaces xs allTerms [] = True allTerms (Left _:_) = False allTerms (_:zs) = allTerms zs fnm = "p" --other names could cause conflicts prShowRule _ = "" -- This recurses to the instance variables of a class. prShowCat :: String -> Either (Cat, Doc) String -> String prShowCat _ (Right _) = "" prShowCat fnm (Left (cat,nt)) | isTokenCat cat = " visit" ++ funName cat ++ "(" ++ fnm ++ "->" ++ render nt ++ ");\n" | cat == InternalCat = "/* Internal Category */\n" | show (normCat $ strToCat $ render nt) /= render nt = accept | otherwise = concat [ " bufAppend('[');\n", " if (" ++ fnm ++ "->" ++ render nt ++ ")" ++ accept, " bufAppend(']');\n" ] where accept = " " ++ fnm ++ "->" ++ render nt ++ "->accept(this);\n" {- **** Helper Functions Section **** -} -- from ListIdent to Ident baseName = drop 4 --The visit-function name of a basic type funName :: Cat -> String funName (TokenCat c) | c `elem` builtin = c where builtin = ["Integer", "Char", "String", "Double", "Ident" ] funName _ = "Ident" --User-defined type --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 :: Integer -> String setI n = "_i_ = " ++ show n ++ "; " --An extremely simple renderer for terminals. prRender :: Bool -> String prRender useStl = unlines [ "//You may wish to change render", "void PrintAbsyn::render(Char c)", "{", " if (c == '{')", " {", " bufAppend('\\n');", " indent();", " bufAppend(c);", " _n_ = _n_ + INDENT_WIDTH;", " bufAppend('\\n');", " indent();", " }", " else if (c == '(' || c == '[')", " bufAppend(c);", " else if (c == ')' || c == ']')", " {", " backup();", " bufAppend(c);", " }", " else if (c == '}')", " {", " int t;", " _n_ = _n_ - INDENT_WIDTH;", " for (t=0; t 0)" , codeblock 2 [ "bufAppend(s);" , "bufAppend(' ');" ] ] in if useStl then render renderString else "", "void PrintAbsyn::render(char* 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.8.1/src/BNFC/Backend/CPP/NoSTL/0000755000000000000000000000000012654616013014633 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/CPP/NoSTL/RegToFlex.hs0000644000000000000000000000443512654616013017034 0ustar0000000000000000module BNFC.Backend.CPP.NoSTL.RegToFlex (printRegFlex) where -- modified from pretty-printer generated by the BNF converter import AbsBNF -- 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 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` ("$+-*=<>[](){}!?.,;:^~|&%#/\\$_@\"" :: String) = '\\':[c] | otherwise = [c] BNFC-2.8.1/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs0000644000000000000000000003152412654616013017020 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- 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 BNFC.Backend.CPP.NoSTL.CFtoCPPAbs (cf2CPPAbs) where import BNFC.CF import BNFC.Utils((+++),(++++)) import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Common.OOAbstract import Data.List import Data.Char(toLower) import Text.PrettyPrint --The result is two files (.H file, .C file) cf2CPPAbs :: String -> CF -> (String, String) cf2CPPAbs _ 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) (getAbstractSyntax cf), "", "#endif" ] where user = fst (unzip (tokenPragmas cf)) header = "/* ~~~ C++ Abstract Syntax Interface generated by the BNF Converter.\n ~~~ */" classes = allClasses (cf2cabs cf) prForward s | isProperLabel s = "class " ++ s ++ ";\n" prForward _ = "" --Prints interface classes for all categories. prDataH :: [UserDef] -> Data -> String prDataH user (cat, rules) = case lookup (show cat) rules of Just _ -> 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] -> Cat -> (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:", render $ nest 2 $ 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:", render $ nest 2 $ 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 c' = identCat (normCat c); mem = drop 4 c' memstar = if isBasic user mem then "" else "*" super = if show 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" 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* " ++ show s ++ ";\n" -- | A class's instance variables. -- >>> prInstVars [Cat "MyTokn"] [("MyTokn",1), ("A",1), ("A",2)] -- MyTokn mytokn_1; -- A *a_1, *a_2; prInstVars :: [UserDef] -> [IVar] -> Doc prInstVars _ [] = empty prInstVars user vars@((t,_):_) = text t <+> uniques <> ";" $$ prInstVars user vs' where (uniques, vs') = prUniques t --these functions group the types together nicely prUniques :: String -> (Doc, [IVar]) prUniques t = (prVars (findIndices (\(y,_) -> y == t) vars), remType t vars) prVars = hsep . punctuate comma . map prVar prVar x = let (t,n) = vars !! x in varLinkName t <> text (showNum n) varLinkName z = if isBasic user z then text (map toLower z) <> "_" else "*" <> text (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) (getAbstractSyntax 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' ++ " ********************/", render $ 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 ++ " ********************/", render $ prConstructorC user fun vs cats, prCopyC user fun vs, prDestructorC user fun vs, prAcceptC fun, prCloneC user fun vs, "" ] where vs = getVars cats 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 [Cat "Integer"] "bla" [("A",1), ("Integer",1), ("A",2)] [Cat "A", Cat "Integer", Cat "A"] -- bla::bla(A *p1, Integer p2, A *p3) { a_1 = p1; integer_ = p2; a_2 = p3; } prConstructorC :: [UserDef] -> String -> [IVar] -> [Cat] -> Doc prConstructorC user c vs cats = text c <> "::" <> text c <> parens (args) <+> "{" <+> text (prAssigns vs params) <> "}" where (types, params) = unzip (prParams cats (length cats) (length cats+1)) args = hsep $ punctuate "," $ zipWith prArg types params prArg type_ name | isBasic user type_ = text type_ <+> text name | otherwise = text type_ <+> "*" <> text name --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 _ c _ = 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 (\(l,_) -> l == t) vs of [] -> varName t +++ "=" +++ p ++ ";" +++ prAssigns vs ps _ -> 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 (map show user) then True else case x of "Integer" -> True "Char" -> True "String" -> True "Double" -> True "Ident" -> True _ -> False BNFC-2.8.1/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs0000644000000000000000000002473612654616013017031 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 BNFC.Backend.CPP.NoSTL.CFtoBison (cf2Bison) where import BNFC.CF import Data.List (intersperse) import BNFC.Backend.Common.NamedVariables hiding (varName) import BNFC.Backend.CPP.STL.CFtoBisonSTL (union) import Data.Char (toLower,isUpper) import BNFC.Utils ((+++)) import BNFC.TypeChecker import ErrM import BNFC.Backend.C.CFtoBisonC (startSymbol) import BNFC.PrettyPrint --This follows the basic structure of CFtoHappy. -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] 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, render $ union Nothing (allCats cf), "%token _ERROR_", tokens user env, declarations cf, startSymbol 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)", "{", " extern char *yytext;", " fprintf(stderr,\"error: line %d: %s at %s\\n\", ", " yy_mylinenumber + 1, str, yytext);", "}", "", definedRules cf, unlines $ map (parseMethod name) (allCatsNorm cf), -- (allEntryPoints cf), M.F. 2004-09-14 fix of [Ty2] bug. concatMap reverseList (filter isList (allCatsNorm 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) = show$normCat$strToCat 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" ++ show (normCat (strToCat x)) ++ " *" cppType (ListT t) = cppType t ++ " *" cppType (BaseT x) | isToken x ctx = "String" | otherwise = show (normCat (strToCat 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 _ 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') ++ "_" --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 nt ++ "> " ++ identCat nt ++ "\n" typeNT _ _ = "" --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user ts = concatMap (declTok user) ts where declTok u (s,r) = if elem s (map show u) then "%token " ++ r ++ " // " ++ s ++ "\n" else "%token " ++ r ++ " // " ++ s ++ "\n" specialToks :: CF -> String specialToks cf = concat [ ifC catString "%token _STRING_\n", ifC catChar "%token _CHAR_\n", ifC catInteger "%token _INTEGER_\n", ifC catDouble "%token _DOUBLE_\n", ifC catIdent "%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 _ 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 (normCat nt) "(:[])" -> identCat (normCat 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 (identCat (normCat 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 ", 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 (show 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 ((_, []):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 :: Cat -> String varName = (++ "_") . map toLower . identCat . normCat typeName :: String -> String typeName "Ident" = "_IDENT_" typeName "String" = "_STRING_" typeName "Char" = "_CHAR_" typeName "Integer" = "_INTEGER_" typeName "Double" = "_DOUBLE_" typeName x = x BNFC-2.8.1/src/BNFC/Backend/CPP/NoSTL/CFtoFlex.hs0000644000000000000000000001646712654616013016657 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 BNFC.Backend.CPP.NoSTL.CFtoFlex (cf2flex) where import BNFC.CF import BNFC.Backend.CPP.NoSTL.RegToFlex import BNFC.Backend.Common.NamedVariables import BNFC.Backend.CPP.STL.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 (tokenNames 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 _ = 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 catString strStates, ifC catChar chStates, ifC catDouble ("{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t " ++ ns ++ "yylval.double_ = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";\n"), ifC catInteger ("{DIGIT}+ \t " ++ ns ++ "yylval.int_ = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";\n"), ifC catIdent ("{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 (show n) env of Just x -> x Nothing -> (show 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) { yyrestart(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.8.1/src/BNFC/Backend/CPP/NoSTL/CFtoCVisitSkel.hs0000644000000000000000000002014112654616013017761 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 BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel (cf2CVisitSkel) where import BNFC.CF import BNFC.Utils ((+++)) import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Utils (isTokenType) import Data.List import Data.Char(toLower, toUpper) import Data.Either (lefts) import BNFC.PrettyPrint --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.show) 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 (show cat) rules of Just _ -> "" Nothing -> " void visit" ++ cl ++ "(" ++ cl ++ "*" +++ vname ++ "); /* abstract class */\n" --Visit functions for a rule. prRuleH :: Rule -> String prRuleH (Rule fun _ _) | 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.show) 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 (render . 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 (show cat) rules of Just _ -> "" Nothing -> "void Skeleton::visit" ++ cl ++ "(" ++ cl ++ "*" +++ vname ++ ") {} //abstract class\n\n" -- | Visits all the instance variables of a category. -- >>> prRule [Cat "A"] (Rule "F" (Cat "S") [Right "X", Left (Cat "A"), Left (Cat "B")]) -- void Skeleton::visitF(F* f) -- { -- /* Code For F Goes Here */ -- -- visitA(f->a_); -- f->b_->accept(this); -- } prRule :: [UserDef] -> Rule -> Doc prRule user (Rule fun _ cats) | not (isCoercion fun) = vcat [ text ("void Skeleton::visit" ++ fun ++ "(" ++ fun ++ "*" +++ fnm ++ ")") , codeblock 2 [ text ("/* Code For " ++ fun ++ " Goes Here */") , "" , cats' ] ] where cats' = vcat (map (prCat user fnm) (lefts (numVars cats))) fnm = map toLower fun prRule _ _ = "" -- | Prints the actual instance-variable visiting. -- >>> prCat [] "Myfun" (Cat "Integer", "integer_") -- visitInteger(Myfun->integer_); -- >>> prCat [] "Myfun" (ListCat (Cat "A"), "lista_") -- if (Myfun->lista_) {Myfun->lista_->accept(this);} -- >>> prCat [] "Myfun" (Cat "A", "a_") -- Myfun->a_->accept(this); prCat :: [Cat] -> String -> (Cat, Doc) -> Doc prCat user fnm (cat, nt) | isTokenType user cat = "visit" <> text (funName (render nt)) <> parens (fname <> "->" <> nt) <> ";" | isList cat = "if" <+> parens (fname <> "->" <> nt) <+> braces accept | otherwise = accept where accept = fname <> "->" <> nt <> "->accept(this);" fname = text fnm --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.show) 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.8.1/src/BNFC/Backend/CPP/STL/0000755000000000000000000000000012654616013014336 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/CPP/STL/STLUtils.hs0000644000000000000000000000243412654616013016360 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 BNFC.Backend.CPP.STL.STLUtils where import Data.Char import Data.Maybe (fromMaybe) nsDefine :: Maybe String -> String -> String nsDefine inPackage h = maybe h (\ns -> map toUpper ns ++ "_" ++ h) inPackage nsStart :: Maybe String -> String nsStart = maybe "" (\ns -> "namespace " ++ ns ++ "\n{") nsEnd :: Maybe String -> String nsEnd = maybe "" (const "}") nsScope :: Maybe String -> String nsScope = maybe "" (++ "::") nsString :: Maybe String -> String nsString = fromMaybe "" BNFC-2.8.1/src/BNFC/Backend/CPP/STL/CFtoCVisitSkelSTL.hs0000644000000000000000000001024312654616013020051 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 BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL (cf2CVisitSkel) where import BNFC.CF import BNFC.Utils ((+++)) import Data.Char(toLower) import BNFC.Backend.Common.OOAbstract import BNFC.Backend.CPP.STL.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" ++ show b ++ "(" ++ show 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 (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.8.1/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs0000644000000000000000000003166412654616013017115 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 BNFC.Backend.CPP.STL.CFtoBisonSTL (cf2Bison, union) where import BNFC.CF import Data.List (intersperse, nub) import BNFC.Backend.Common.NamedVariables hiding (varName) import Data.Char (toLower,isUpper) import BNFC.Utils ((+++)) import BNFC.TypeChecker import ErrM import BNFC.Backend.CPP.STL.STLUtils import BNFC.Backend.C.CFtoBisonC (startSymbol) import BNFC.PrettyPrint --This follows the basic structure of CFtoHappy. -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] 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, render $ union inPackage (positionCats cf ++ allCats cf), maybe "" (\ns -> "%name-prefix=\"" ++ ns ++ "yy\"") inPackage, "%token _ERROR_", tokens user env, declarations cf, startSymbol 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)", "{", " extern char *yytext;", " fprintf(stderr,\"error: line %d: %s at %s\\n\", ", " yy_mylinenumber, str, yytext);", "}", "", definedRules cf, nsStart inPackage, unlines $ map (parseMethod inPackage name) (allCatsNorm 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) = show $ normCat $ strToCat 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" ++ show (normCat $ strToCat x) ++ " *" cppType (ListT t) = cppType t ++ " *" cppType (BaseT x) | isToken x ctx = "String" | otherwise = (show $ normCat $ strToCat 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 _ 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. -- -- >>> let foo = Cat "Foo" -- >>> union Nothing [foo, ListCat foo] -- %union -- { -- int int_; -- char char_; -- double double_; -- char* string_; -- Foo* foo_; -- ListFoo* listfoo_; -- } -- -- If the given list of categories is contains coerced categories, those should -- be normalized and duplicate removed -- E.g. if there is both [Foo] and [Foo2] we should only print one pointer: -- ListFoo* listfoo_; -- -- >>> let foo2 = CoercCat "Foo" 2 -- >>> union Nothing [foo, ListCat foo, foo2, ListCat foo2] -- %union -- { -- int int_; -- char char_; -- double double_; -- char* string_; -- Foo* foo_; -- ListFoo* listfoo_; -- } union :: Maybe String -> [Cat] -> Doc union inPackage cats = "%union" $$ codeblock 2 ( [ "int int_;" , "char char_;" , "double double_;" , "char* string_;" ] ++ map mkPointer normCats ) where normCats = nub (map normCat cats) mkPointer s = scope <> text (identCat s) <> "*" <+> text (varName s) <> ";" scope = text (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 nt) ++ "> " ++ (identCat nt) ++ "\n" typeNT _ _ = "" --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user ts = concatMap (declTok user) ts where declTok u (s,r) = if elem s (map show u) then "%token " ++ r ++ " // " ++ s ++ "\n" else "%token " ++ r ++ " // " ++ s ++ "\n" specialToks :: CF -> String specialToks cf = concat [ ifC catString "%token _STRING_\n", ifC catChar "%token _CHAR_\n", ifC catInteger "%token _INTEGER_\n", ifC catDouble "%token _DOUBLE_\n", ifC catIdent "%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 _ 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 (show cat) id (lookup (show cat) env), "$$ = new " ++ show cat ++ "($1," ++ nsString inPackage ++ "yy_mylinenumber) ; YY_RESULT_" ++ show 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 (identCat (normCat 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(" ++ head ms ++ ") ; $$ = " ++ 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 lastms = last ms addLn ln = if ln then " $$->line_number = " ++ nsString inPackage ++ "yy_mylinenumber;" else "" -- O.F. identCatV = identCat . normCat 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 _ = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> case lookup (show 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 = (isList 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 ((_, []):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 :: Cat -> String varName = (++ "_") . map toLower . identCat . normCat typeName :: String -> String typeName "Ident" = "_IDENT_" typeName "String" = "_STRING_" typeName "Char" = "_CHAR_" typeName "Integer" = "_INTEGER_" typeName "Double" = "_DOUBLE_" typeName x = x BNFC-2.8.1/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs0000644000000000000000000001655712654616013016554 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 BNFC.Backend.CPP.STL.CFtoSTLAbs (cf2CPPAbs) where import BNFC.Backend.Common.OOAbstract import BNFC.CF import BNFC.Utils((+++)) import Data.List import BNFC.Backend.CPP.STL.STLUtils --The result is two files (.H file, .C file) cf2CPPAbs :: Bool -> Maybe String -> String -> CF -> (String, String) cf2CPPAbs ln inPackage _ 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 -> String -> String prAbs ln c = unlines [ "class " ++ c ++ " : public Visitable", "{", "public:", " virtual " ++ c ++ " *clone() const = 0;", if ln then " int line_number;" else "", "};" ] prCon :: (String, 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 :: (String,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,_) = unlines [ "/******************** " ++ f ++ " ********************/", prConstructorC fcs, prCopyC fcs, prDestructorC fcs, prAcceptC f, prCloneC f, "" ] prListC :: String -> String prListC c = unlines [ "/******************** " ++ c ++ " ********************/", "", prAcceptC c, "", prCloneC c ] --The standard accept function for the Visitor pattern prAcceptC :: String -> String prAcceptC ty = unlines [ "void " ++ ty ++ "::accept(Visitor *v)", "{", " v->visit" ++ ty ++ "(this);", "}" ] --The cloner makes a new deep copy of the object prCloneC :: String -> 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 | ((_,_,_),i) <- zip cs [1..]] conargs = intercalate ", " [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.8.1/src/BNFC/Backend/HaskellGADT/0000755000000000000000000000000012654616013015275 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/HaskellGADT/HaskellGADTCommon.hs0000644000000000000000000000613012654616013021025 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 BNFC.Backend.HaskellGADT.HaskellGADTCommon (Constructor(..), cf2cons, isTreeType) where import BNFC.CF import Data.Char data Constructor = Constructor { consCat :: Cat, consFun :: Fun, consPrec :: Integer, 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 = show cat, consPrec = 0, consVars = [(Cat "String","str")], consRhs = [Left (Cat "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 (ListCat cat) = var cat ++ "s" var (Cat "Ident") = "i" var (Cat "Integer") = "n" var (Cat "String") = "str" var (Cat "Char") = "c" var (Cat "Double") = "d" var xs = map toLower $show 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 -> Integer 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.8.1/src/BNFC/Backend/HaskellGADT/CFtoAbstractGADT.hs0000644000000000000000000001373112654616013020615 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 BNFC.Backend.HaskellGADT.CFtoAbstractGADT (cf2Abstract) where import BNFC.CF import BNFC.Utils((+++)) import Data.List(intersperse,intercalate,nub) import BNFC.Backend.HaskellGADT.HaskellGADTCommon -- to produce a Haskell module cf2Abstract :: Bool -> String -> CF -> String -> String cf2Abstract byteStrings name cf composOpMod = unlines $ [ "{-# LANGUAGE GADTs, KindSignatures, DataKinds #-}", "module" +++ name +++ "(" ++ concat (intersperse ", " exports) ++ ")" +++ "where", "", "import " ++ composOpMod, "", "import Data.Monoid (mappend)", (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 $ map show $ filter (not . isList) $ map consCat $ cf2cons cf prDummyTypes :: CF -> [String] prDummyTypes cf = [prDummyData] ++ map prDummyType cats where cats = getTreeCats cf prDummyData = "data Tag =" +++ intercalate " | " (map mkRealType cats) prDummyType cat = "type" +++ cat +++ "= Tree" +++ mkRealType cat mkRealType :: String -> String mkRealType cat = cat ++ "_" -- FIXME: make sure that there is no such category already prTreeType :: Bool -> CF -> [String] prTreeType byteStrings cf = ["data Tree :: Tag -> * where"] ++ map ((" "++) . prTreeCons) (cf2cons cf) where prTreeCons c | isPositionCat cf cat = fun +++ ":: ((Int,Int),"++stringType++") -> Tree" +++ mkRealType (show cat) | otherwise = fun +++ "::" +++ concat [show c +++ "-> " | (c,_) <- consVars c] ++ "Tree" +++ mkRealType (show 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.8.1/src/BNFC/Backend/HaskellGADT/CFtoTemplateGADT.hs0000644000000000000000000000424512654616013020625 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 BNFC.Backend.HaskellGADT.CFtoTemplateGADT ( cf2Template ) where import BNFC.CF import BNFC.Utils((+++)) import Data.List (groupBy) import BNFC.Backend.HaskellGADT.HaskellGADTCommon type ModuleName = String cf2Template :: ModuleName -> ModuleName -> ModuleName -> CF -> String cf2Template skelName absName errName cf = unlines $ [ "{-# LANGUAGE GADTs #-}", "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" ++ show cat +++ "::" +++ show cat +++ "-> Result", "trans" ++ show cat +++ "t = case t of"] ++ map prConsCase cs BNFC-2.8.1/src/BNFC/Backend/OCaml/0000755000000000000000000000000012654616013014245 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs0000644000000000000000000002102312654616013017712 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 BNFC.Backend.OCaml.CFtoOCamlPrinter (cf2Printer) where import BNFC.CF import BNFC.Utils import Data.List (intersperse, sortBy) import Data.Char(toLower) import BNFC.Backend.OCaml.OCamlUtil import BNFC.PrettyPrint import BNFC.Backend.Haskell.CFtoPrinter (compareRules) -- 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 _ 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 reserved = "i":"e":reservedOCaml toArgs (cons,args) = ((cons, mkNames reserved LowerCase (map var args)), ruleOf cons) names [] _ = [] names (x:xs) n | elem x xs = (x ++ show n) : names xs (n+1) | otherwise = x : names xs n var (ListCat c) = var c ++ "s" var (Cat "Ident") = "id" var (Cat "Integer") = "n" var (Cat "String") = "str" var (Cat "Char") = "c" var (Cat "Double") = "d" var xs = map toLower (show 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 ifList :: CF -> Cat -> String ifList cf cat = case cases of [] -> "" first:rest -> render $ vcat [ "and prt" <> text (fixTypeUpper cat) <> "ListBNFC i es : doc = match (i, es) with" , nest 4 first , nest 2 $ vcat (map ("|" <+>) rest) ] where rules = sortBy compareRules $ rulesForNormalizedCat cf (ListCat cat) cases = [ mkPrtListCase r | r <- rules ] -- | Pattern match on the list constructor and the coercion level -- >>> mkPrtListCase (Rule "[]" (ListCat (Cat "Foo")) []) -- (_,[]) -> (concatD []) -- >>> mkPrtListCase (Rule "(:[])" (ListCat (Cat "Foo")) [Left (Cat "Foo")]) -- (_,[x]) -> (concatD [prtFoo 0 x]) -- >>> mkPrtListCase (Rule "(:)" (ListCat (Cat "Foo")) [Left (Cat "Foo"), Left (ListCat (Cat "Foo"))]) -- (_,x::xs) -> (concatD [prtFoo 0 x ; prtFooListBNFC 0 xs]) -- >>> mkPrtListCase (Rule "[]" (ListCat (CoercCat "Foo" 2)) []) -- (2,[]) -> (concatD []) -- >>> mkPrtListCase (Rule "(:[])" (ListCat (CoercCat "Foo" 2)) [Left (CoercCat "Foo" 2)]) -- (2,[x]) -> (concatD [prtFoo 2 x]) -- >>> mkPrtListCase (Rule "(:)" (ListCat (CoercCat "Foo" 2)) [Left (CoercCat "Foo" 2), Left (ListCat (CoercCat "Foo" 2))]) -- (2,x::xs) -> (concatD [prtFoo 2 x ; prtFooListBNFC 2 xs]) mkPrtListCase :: Rule -> Doc mkPrtListCase (Rule f (ListCat c) rhs) | isNilFun f = parens (precPattern <> "," <> "[]") <+> "->" <+> body | isOneFun f = parens (precPattern <> "," <> "[x]") <+> "->" <+> body | isConsFun f = parens (precPattern <> "," <>"x::xs") <+> "->" <+> body | otherwise = empty -- (++) constructor where precPattern = case precCat c of 0 -> "_" ; p -> integer p body = text $ mkRhs ["x", "xs"] rhs mkRhs args its = "(concatD [" ++ unwords (intersperse ";" (mk args its)) ++ "])" where mk args (Left InternalCat : 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 (ListCat c) = prtFun c ++ "ListBNFC" prtFun c = "prt" ++ fixTypeUpper (normCat c) BNFC-2.8.1/src/BNFC/Backend/OCaml/CFtoOCamlTemplate.hs0000644000000000000000000000465212654616013020053 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 BNFC.Backend.OCaml.CFtoOCamlTemplate ( cf2Template ) where import BNFC.CF import Data.Char import BNFC.Backend.OCaml.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 (ListCat c) = var c ++ "s" var (Cat "Ident") = "id" var (Cat "Integer") = "n" var (Cat "String") = "str" var (Cat "Char") = "c" var (Cat "Double") = "d" var cat = map toLower (show cat) checkRes s | elem s reservedOCaml = s ++ "'" | otherwise = s case_fun :: Cat -> [Constructor] -> String case_fun cat xs = unlines $ ["trans" ++ show cat ++ " (x : " ++ fixType cat ++ ") : result = match x with", unlines $ insertBar $ map (\s -> s ++ " -> " ++ "failure x") xs] BNFC-2.8.1/src/BNFC/Backend/OCaml/CFtoOCamlLex.hs0000644000000000000000000002435112654616013017026 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 BNFC.Backend.OCaml.CFtoOCamlLex (cf2ocamllex) where import Control.Arrow ((&&&)) import Data.List import Data.Char import Text.PrettyPrint hiding (render) import qualified Text.PrettyPrint as PP import BNFC.CF import AbsBNF import BNFC.Backend.OCaml.CFtoOCamlYacc (terminal) import BNFC.Utils ((+++)) cf2ocamllex :: String -> String -> CF -> String cf2ocamllex _ parserMod cf = unlines $ intercalate [""] [ header parserMod cf, definitions cf, [PP.render (rules cf)] ] 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 _ syms | null syms = "" 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, uMacros 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] -- user macros, derived from the user-defined tokens uMacros :: CF -> [String] uMacros cf = ["let " ++ name ++ " = " ++ rep | (name, rep, _) <- userTokens cf] -- returns the tuple of (reg_name, reg_representation, token_name) userTokens :: CF -> [(String, String, String)] userTokens cf = let regName = map toLower . show in [(regName name, printRegOCaml reg, show name) | (name, reg) <- tokenPragmas cf] -- | Make OCamlLex rule -- >>> mkRule "token" [("REGEX1","ACTION1"),("REGEX2","ACTION2"),("...","...")] -- rule token = -- parse REGEX1 {ACTION1} -- | REGEX2 {ACTION2} -- | ... {...} -- -- If no regex are given, we dont create a lexer rule: -- >>> mkRule "empty" [] -- mkRule :: Doc -> [(Doc,Doc)] -> Doc mkRule _ [] = empty mkRule entrypoint (r1:rn) = vcat [ "rule" <+> entrypoint <+> "=" , nest 2 $ hang "parse" 4 $ vcat (nest 2 (mkOne r1):map (("|" <+>) . mkOne) rn) ] where mkOne (regex, action) = regex <+> braces action -- | Create regex for single line comments -- >>> mkRegexSingleLineComment "--" -- "--" (_ # '\n')* mkRegexSingleLineComment :: String -> Doc mkRegexSingleLineComment s = doubleQuotes (text s) <+> "(_ # '\\n')*" -- | Create regex for multiline comments -- >>> mkRegexMultilineComment "" -- "" mkRegexMultilineComment :: String -> String -> Doc mkRegexMultilineComment b e = lit b <+> parens ( hsep $ intersperse "|" subregexs ) <> "*" <+> lit [head e] <> "*" <+> lit e where lit :: String -> Doc lit "" = empty lit [c] = quotes (char c) lit s = doubleQuotes (text s) prefix = map (init &&& last) (drop 1 (inits e)) subregexs = [ lit ss <+> parens ("u #" <+> brackets (lit [s])) | (ss,s) <- prefix] -- | Uses the function from above to make a lexer rule from the CF grammar rules :: CF -> Doc rules cf = mkRule "token" $ -- comments [ (mkRegexSingleLineComment s, "token lexbuf") | s <- singleLineC ] ++ [ (mkRegexMultilineComment b e, "token lexbuf") | (b,e) <- multilineC] ++ -- user tokens [ (text n , tokenAction (text t)) | (n,_,t) <- userTokens cf] ++ -- predefined tokens [ ( "l i*", tokenAction "Ident" ) ] ++ [ ( "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\")" ) | not (null (symbols cf))] ++ -- integers [ ( "d+", "let i = lexeme lexbuf in TOK_Integer (int_of_string i)" ) -- doubles , ( "d+ '.' d+ ('e' ('-')? d+)?" , "let f = lexeme lexbuf in TOK_Double (float_of_string f)" ) -- strings , ( "'\\\"' ((u # ['\\\"' '\\\\' '\\n']) | ('\\\\' ('\\\"' | '\\\\' | '\\\'' | 'n' | 't')))* '\\\"'" , "let s = lexeme lexbuf in TOK_String (unescapeInitTail s)" ) -- chars , ( "'\\'' ((u # ['\\\'' '\\\\']) | ('\\\\' ('\\\\' | '\\\'' | 'n' | 't'))) '\\\''" , "let s = lexeme lexbuf in TOK_Char s.[1]") -- spaces , ( "[' ' '\\t']", "token lexbuf") -- new lines , ( "'\\n'", "incr_lineno lexbuf; token lexbuf" ) -- end of file , ( "eof", "TOK_EOF" ) ] where (multilineC, singleLineC) = comments cf tokenAction t = case reservedWords cf of [] -> "let l = lexeme lexbuf in TOK_" <> t <>" l" _ -> "let l = lexeme lexbuf in try Hashtbl.find resword_table l with Not_found -> TOK_" <> t <+> "l" ------------------------------------------------------------------- -- 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 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 [["["], [concatMap show 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.8.1/src/BNFC/Backend/OCaml/OCamlUtil.hs0000644000000000000000000000462512654616013016441 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 BNFC.Backend.OCaml.OCamlUtil where import BNFC.CF import BNFC.Utils import Data.Char (toLower, toUpper) -- Translate Haskell types to OCaml types -- Note: OCaml (data-)types start with lowercase letter fixType :: Cat -> String fixType (ListCat c) = fixType c +++ "list" fixType (TokenCat "Integer") = "int" fixType (TokenCat "Double") = "float" fixType cat = let c:cs = show cat in let ls = toLower c : cs in if (elem ls reservedOCaml) then (ls ++ "T") else ls -- 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","list","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.8.1/src/BNFC/Backend/OCaml/CFtoOCamlShow.hs0000644000000000000000000001155012654616013017213 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 BNFC.Backend.OCaml.CFtoOCamlShow (cf2show) where import BNFC.CF import BNFC.Utils import Data.List (intersperse) import Data.Char(toLower) import BNFC.Backend.OCaml.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 _ 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 _ = "let showInt (i:int) : showable = s2s (string_of_int i)" doubleRule _ = "let showFloat (f:float) : showable = s2s (string_of_float f)" identRule cf = ownPrintRule cf (Cat "Ident") ownPrintRule cf own = unlines $ [ "let rec" +++ showsFun own +++ "(" ++ show own ++ posn ++ ") : showable = s2s \"" ++ show 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 (ListCat c) = var c ++ "s" var (Cat "Ident") = "id" var (Cat "Integer") = "n" var (Cat "String") = "str" var (Cat "Char") = "c" var (Cat "Double") = "d" var cat = map toLower (show cat) 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 InternalCat : items) = mk args items mk (arg:args) (Left c : items) = (showsFun c +++ arg) : mk args items mk args (Right _ : items) = mk args items mk _ _ = [] showsFun :: Cat -> String showsFun c = case c of ListCat t -> "showList" +++ showsFun t _ -> "show" ++ (fixTypeUpper $ normCat c) BNFC-2.8.1/src/BNFC/Backend/OCaml/CFtoOCamlYacc.hs0000644000000000000000000002033412654616013017152 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 BNFC.Backend.OCaml.CFtoOCamlYacc ( cf2ocamlyacc, terminal ) where import BNFC.CF import Data.List (intersperse,nub) import Data.Char import BNFC.Utils ((+++)) import BNFC.Backend.OCaml.OCamlUtil -- Type declarations type Pattern = String type Action = String type MetaVar = String -- 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 cf, declarations absName cf, "%%", rules cf ] header :: String -> String -> String -> CF -> String header _ absName _ cf = unlines ["/* This ocamlyacc file was machine-generated by the BNF converter */", "%{", "open " ++ absName, "open Lexing", "", definedRules cf, "%}" ] definedRules :: CF -> String definedRules cf = unlines [mkDef f xs e | FunDef f xs e <- pragmasOfCF cf] where mkDef f xs e = "let " ++ f ++ " " ++ mkTuple xs ++ " = " ++ ocamlExp e where ocamlExp :: Exp -> String ocamlExp (App s es) = s ++ ' ' : mkTuple (map ocamlExp es) ocamlExp (LitInt i) = show i ocamlExp (LitDouble d) = show d ocamlExp (LitChar c) = "\'" ++ c : "\'" ocamlExp (LitString s) = "\"" ++ s ++ "\"" 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"] ++ map show (literals cf))) where aux cat = "%token" +++ (case cat of "Ident" -> "" "String" -> "" "Integer" -> "" "Double" -> "" "Char" -> "" _ -> "" ) +++ "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` [ TokenCat "Integer", TokenCat "Double", TokenCat "Char", TokenCat "String", ListCat (TokenCat "Integer"), ListCat (TokenCat "Double"), ListCat (TokenCat "Char"), ListCat (TokenCat "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 :: Cat -> 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 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 _ 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 TokenCat "Ident" -> "ident : TOK_Ident { Ident $1 };" TokenCat "String" -> "string : TOK_String { $1 };" TokenCat "Integer" -> "int : TOK_Integer { $1 };" TokenCat "Double" -> "float : TOK_Double { $1 };" TokenCat "Char" -> "char : TOK_Char { $1 };" own -> (fixType own) ++ " : TOK_" ++ show own ++ " { " ++ show 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.8.1/src/BNFC/Backend/OCaml/CFtoOCamlTest.hs0000644000000000000000000000643712654616013017222 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 BNFC.Backend.OCaml.CFtoOCamlTest where import Text.PrettyPrint import BNFC.CF import BNFC.Backend.OCaml.OCamlUtil -- | OCaml comment -- >>> comment "I'm a comment" -- (* I'm a comment *) comment :: Doc -> Doc comment d = "(*" <+> d <+> "*)" -- | OCaml String concatenation -- >>> "print a" <^> doubleQuotes "abc" -- print a ^ "abc" a <^> b = a <+> "^" <+> b -- | Generate a test program in OCaml ocamlTestfile :: String -> String -> String -> String -> String -> CF -> Doc ocamlTestfile absM lexM parM printM showM cf = let lexerName = text lexM <> ".token" parserName = text parM <> ".p" <> topTypeC printerName = text printM <> ".printTree " <> text printM <> ".prt" <> topTypeC showFun = parens ("fun x ->" <+> text showM <> ".show" <+> parens (text showM <> ".show" <> topTypeC <+> "x")) topTypeC = text $ fixTypeUpper (firstEntry cf) topType = text absM <> "." <> text (fixType (firstEntry cf)) in vcat [ comment "automatically generated by the BNF Converter" , "" , "open Lexing" , "" , "let parse (c : in_channel) :" <+> topType <+> "=" , nest 4 (parserName <+> lexerName <+> "(Lexing.from_channel c)") , ";;" , "" , "let showTree (t : " <> topType <> ") : string =" , nest 4 (fsep ( punctuate "^" [ doubleQuotes "[Abstract syntax]\\n\\n" , showFun <+> "t" , doubleQuotes "\\n\\n" , doubleQuotes "[Linearized tree]\\n\\n" , printerName <+> "t" , doubleQuotes "\\n" ] ) ) , ";;" , "" , "let main () =" , nest 4 $ vcat [ "let channel =" , nest 4 $ vcat [ "if Array.length Sys.argv > 1 then open_in Sys.argv.(1)" , "else stdin" ] , "in" , "try" , nest 4 $ vcat [ "print_string (showTree (parse channel));" , "flush stdout;" , "exit 0"] , "with BNFC_Util.Parse_error (start_pos, end_pos) ->" , nest 4 $ vcat [ "Printf.printf \"Parse error at %d.%d-%d.%d\\n\"" , nest 4 $ vcat [ "start_pos.pos_lnum (start_pos.pos_cnum - start_pos.pos_bol)" , "end_pos.pos_lnum (end_pos.pos_cnum - end_pos.pos_bol);" ] , "exit 1" ]] , ";;" , "" , "main ();;" ] BNFC-2.8.1/src/BNFC/Backend/OCaml/CFtoOCamlAbs.hs0000644000000000000000000000463312654616013017004 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 BNFC.Backend.OCaml.CFtoOCamlAbs (cf2Abstract) where import Text.PrettyPrint import BNFC.CF import BNFC.Utils((+++)) import Data.List(intersperse) import BNFC.Backend.OCaml.OCamlUtil -- to produce an OCaml module cf2Abstract :: String -> CF -> String cf2Abstract _ 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" +++ render (mkTupleType cats) -- | Creates an OCaml type tuple by intercalating * between type names -- >>> mkTupleType [Cat "A"] -- a -- -- >>> mkTupleType [Cat "A", Cat "Abc", Cat "S"] -- a * abc * s mkTupleType :: [Cat] -> Doc mkTupleType = hsep . intersperse (char '*') . map (text . fixType) prSpecialData :: CF -> Cat -> String prSpecialData cf cat = fixType cat +++ "=" +++ show 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.8.1/src/BNFC/Backend/HaskellProfile/0000755000000000000000000000000012654616013016156 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/HaskellProfile/CFtoHappyProfile.hs0000644000000000000000000001715512654616013021701 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 BNFC.Backend.HaskellProfile.CFtoHappyProfile ( cf2HappyProfileS ) where import BNFC.CF --import Lexer import Data.List (intersperse) -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type Pattern = String type Action = String type MetaVar = String -- default naming 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 (allEntryPoints 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 _ 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 :: [Cat] -> 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 _ 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 _ (_,(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 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 _ = 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)) where aux cat = case cat of Cat "Ident" -> "L_ident { PT _ (TV $$) }" Cat "String" -> "L_quoted { PT _ (TL $$) }" Cat "Integer" -> "L_integ { PT _ (TI $$) }" Cat "Double" -> "L_doubl { PT _ (TD $$) }" Cat "Char" -> "L_charac { PT _ (TC $$) }" own -> "L_" ++ show own ++ " { PT _ (T_" ++ show 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 Cat "Ident" -> "Ident : L_ident { mkAtTree (AV (Ident $1)) }" Cat "String" -> "String : L_quoted { mkAtTree (AS $1) }" Cat "Integer" -> "Integer : L_integ { mkAtTree (AI ((read $1) :: Integer)) }" Cat "Double" -> "Double : L_doubl { (read $1) :: Double }" ---- Cat "Char" -> "Char : L_charac { (read $1) :: Char }" ---- own -> show own ++ " : L_" ++ show own ++ " { " ++ show own ++ " ("++ posn ++ "$1)}" where posn = if isPositionCat cf cat then "mkPosToken " else "" BNFC-2.8.1/src/BNFC/Backend/CSharp/0000755000000000000000000000000012654616013014432 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/CSharp/CAbstoCSharpVisitSkeleton.hs0000644000000000000000000001024012654616013021763 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 BNFC.Backend.CSharp.CAbstoCSharpVisitSkeleton (cabs2csharpvisitskeleton) where import BNFC.Utils ((+++)) import Data.List import BNFC.Backend.Common.OOAbstract hiding (basetypes) import BNFC.Backend.CSharp.CSharpUtils --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 -> (String, [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 -> (String, Bool, VariableName, PropertyName) -> String prVisitArg namespace vname (cat, _, 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.8.1/src/BNFC/Backend/CSharp/RegToGPLEX.hs0000644000000000000000000000454012654616013016611 0ustar0000000000000000module BNFC.Backend.CSharp.RegToGPLEX (printRegGPLEX) where -- modified from RegToFlex import AbsBNF -- 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 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` ("$+-*=<>[](){}!?.,;:^~|&%#/\\$_@\"" :: String) = '\\':[c] | otherwise = [c] BNFC-2.8.1/src/BNFC/Backend/CSharp/CAbstoCSharpAbstractVisitSkeleton.hs0000644000000000000000000000675612654616013023470 0ustar0000000000000000{- BNF Converter: C# Abstract Visit Skeleton Generator Copyright (C) 2006 Author: Johan Broberg Modified from BNFC.Backend.CSharp.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 BNFC.Backend.CSharp.CAbstoCSharpAbstractVisitSkeleton (cabs2csharpAbstractVisitSkeleton) where import BNFC.CF import BNFC.Utils ((+++)) import BNFC.Backend.Common.OOAbstract hiding (basetypes) import BNFC.Backend.CSharp.CSharpUtils --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 -> (String, [CAbsRule]) -> String prCon namespace (c,fs) = unlinesInline [ " public abstract class Abstract" ++ c ++ "Visitor : " ++ identifier namespace c ++ ".Visitor", " {", unlinesInlineMap (prVisit namespace) fs, " }" ] prVisit :: Namespace -> (Fun, [(String, Bool, String)]) -> String prVisit namespace (f,_) = unlinesInline [ " public abstract R Visit(" ++ identifier namespace f +++ varname f ++ ", A arg);" ] BNFC-2.8.1/src/BNFC/Backend/CSharp/CFtoGPLEX.hs0000644000000000000000000002216612654616013016430 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 BNFC.Backend.CSharp.CFtoGPLEX (cf2gplex) where import BNFC.CF import BNFC.Backend.CSharp.RegToGPLEX import BNFC.Backend.Common.NamedVariables import Data.List import BNFC.Backend.CSharp.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 (tokenNames 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 catString strStates, ifC catChar charStates, ifC catDouble [("{digit}+\".\"{digit}+(\"e\"(\\-)?{digit}+)?" , "if(Trace) System.Console.Error.WriteLine(yytext); yylval.double_ = Double.Parse(yytext, InvariantFormatInfo); return (int)Tokens.DOUBLE_;")], ifC catInteger [("{digit}+" , "if(Trace) System.Console.Error.WriteLine(yytext); yylval.int_ = Int32.Parse(yytext, InvariantFormatInfo); return (int)Tokens.INTEGER_;")], ifC catIdent [("{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 (show$normCat n) ++ " = new " ++ identifier namespace (show n) ++ "(yytext); return (int)Tokens." ++ sName n ++ ";" sName n = case lookup (show n) env of Just x -> x Nothing -> show 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.8.1/src/BNFC/Backend/CSharp/CSharpUtils.hs0000644000000000000000000001325312654616013017173 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 BNFC.Backend.CSharp.CSharpUtils where import BNFC.CF import Data.Char (toLower) import Data.List import BNFC.Backend.Common.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 -> String -> Bool isAlsoCategory f c = f == c flattenSignatures :: CAbs -> [(String, 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,[(String,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 :: [(String, Bool, String)] -> [(String, 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 :: String -> 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 Cat 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 (identCat (normCat f)) BNFC-2.8.1/src/BNFC/Backend/CSharp/CAbstoCSharpAbs.hs0000644000000000000000000002103512654616013017671 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 BNFC.Backend.CSharp.CAbstoCSharpAbs (cabs2csharpabs) where import BNFC.Backend.Common.OOAbstract import BNFC.CF import BNFC.Utils((+++)) import Data.List import Data.Maybe import BNFC.Backend.CSharp.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 -> [String] -> String prDataContract False _ = "" prDataContract True [] = " [DataContract]" prDataContract True funs = unlinesInline [ prDataContract True [], unlinesInline $ map prDataContract' funs ] where prDataContract' :: String -> 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 -> String -> 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 -> (String, [String]) -> 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 -> [String] -> 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 -> (String,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 $ strToCat 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 _ _ 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 -> (String,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 -> String -> 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 | ((_,_,_,_),i) <- zip cs [1..]] conargs = concat $ intersperse ", " [identifier namespace (typename x) +++ v | ((x,_,_,_),v) <- zip cs pvs] BNFC-2.8.1/src/BNFC/Backend/CSharp/CFtoCSharpPrinter.hs0000644000000000000000000003365612654616013020303 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 BNFC.Backend.CSharp.CFtoCSharpPrinter (cf2csharpprinter) where import BNFC.CF import BNFC.Utils ((+++)) import BNFC.Backend.Common.NamedVariables import Data.List import Data.Char(toLower) import Data.Maybe import BNFC.Backend.CSharp.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 int INDENT_WIDTH = 2;", " 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_ + INDENT_WIDTH;", " buffer.Append(\"\\n\");", " Indent();", " }", " else if(s == \"(\" || s == \"[\")", " buffer.Append(s);", " else if(s == \")\" || s == \"]\")", " {", " Backup();", " buffer.Append(s);", " buffer.Append(\" \");", " }", " else if(s == \"}\")", " {", " int t;", " _n_ = _n_ - INDENT_WIDTH;", " for(t=0; t 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 -> String -> 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 -> String -> 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 _ _ 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 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 _ _ _rules = unlinesInline [ " for(int i=0; i < p.Count; i++)", " {", " ShowInternal(p[i]);", " if(i < p.Count - 1)", " Render(\",\");", " }" ] 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 == show InternalCat ++ "_" BNFC-2.8.1/src/BNFC/Backend/CSharp/CFtoGPPG.hs0000644000000000000000000002302112654616013016275 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 BNFC.Backend.CSharp.CFtoGPPG (cf2gppg) where import BNFC.CF import Data.List (intersperse) import BNFC.Backend.Common.NamedVariables hiding (varName) import Data.Char (toLower) import BNFC.Utils ((+++)) import BNFC.TypeChecker import ErrM import BNFC.Backend.Common.OOAbstract hiding (basetypes) import BNFC.Backend.CSharp.CSharpUtils --This follows the basic structure of CFtoHappy. -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] 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 ++ map strToCat (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) (allCatsNorm cf ++ positionCats cf), "%}" ] definedRules :: Namespace -> CF -> String definedRules _ 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) = show$normCat$strToCat 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 (_,(_,_)) -> 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 /= show cat) || ((normCat cat) == cat) = " public " ++ identifier namespace (identCat (normCat cat)) +++ (varName (show$normCat cat)) ++ ";" catline _ = "" --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 (show$normCat nt)) ++ "> " ++ (show$normCat nt) typeNT _ _ = "" --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user ts = concatMap (declTok user) ts where declTok u (s,r) = if elem s (map show u) then "%token<" ++ varName (show$normCat$strToCat s) ++ "> " ++ r ++ " // " ++ show s ++ "\n" else "%token " ++ r ++ " // " ++ show s ++ "\n" specialToks :: CF -> String specialToks cf = unlinesInline [ ifC catString "%token STRING_", ifC catChar "%token CHAR_", ifC catInteger "%token INTEGER_", ifC catDouble "%token DOUBLE_", ifC catIdent "%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 (show cat) id (lookup (show cat) env), "$$ = new " ++ show 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 (identCat (normCat 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 _ = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where mkIt i = case i of Left c -> case lookup (show 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) && (show 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 = (isList 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 ((_, []):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 $ strToCat s)) ++ "_" typeName :: String -> String typeName "Ident" = "IDENT_" typeName "String" = "STRING_" typeName "Char" = "CHAR_" typeName "Integer" = "INTEGER_" typeName "Double" = "DOUBLE_" typeName x = x BNFC-2.8.1/src/BNFC/Backend/Haskell/0000755000000000000000000000000012654616013014635 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/Haskell/CFtoLayout.hs0000644000000000000000000002650212654616013017227 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 BNFC.Backend.Haskell.CFtoLayout where import Data.List (sort) import BNFC.CF layoutOpen = "{" layoutClose = "}" layoutSep = ";" cf2Layout :: Bool -> Bool -> String -> String -> CF -> String cf2Layout alex1 _ 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 :: Bool", "topLayout = " ++ show top, "", "layoutWords, layoutStopWords :: [String]", "layoutWords = " ++ show lay, "layoutStopWords = " ++ show stop, "", "-- layout separators", "", "", "layoutOpen, layoutClose, layoutSep :: String", "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", "", " -- 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 pt t0 && 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')", "", " res pt 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 -- Do we have to insert an extra layoutSep?", " case st of", " Implicit n:_", " | newLine pt t0 && column t0 == n", " && not (isNothing pt ||", " isTokenIn [layoutSep,layoutOpen] (fromJust pt)) ->", " let b':t0':b'':ts'' =", " addToken (afterPrev pt) layoutSep (t0:b:ts')", " in moveAlong st' [b',t0',b''] ts'", " _ -> 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", "", " -- Insert separator if necessary.", " res pt st@(Implicit n:ns) (t0:ts)", " -- Encounted a new line in an implicit layout block.", " | newLine pt t0 && 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'", "", " -- 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 _ [] _ = error $ \"Layout error: moveAlong got [] as old tokens\"", " moveAlong st ot ts = ot ++ res (Just $ last ot) st ts", "", " newLine :: Maybe Token -> Token -> Bool", " newLine pt t0 = case pt of", " Nothing -> True", " Just t -> line t /= line t0", "", "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.8.1/src/BNFC/Backend/Haskell/MkErrM.hs0000644000000000000000000000402612654616013016330 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 BNFC.Backend.Haskell.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)" ,"import Control.Applicative (Applicative(..), Alternative(..))" ,"" ,"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 >>= _ = Bad s" ,"" ,"instance Applicative Err where" ," pure = Ok" ," (Bad s) <*> _ = Bad s" ," (Ok f) <*> o = liftM f o" ,"" ,"" ,"instance Functor Err where" ," fmap = liftM" ,"" ,"instance MonadPlus Err where" ," mzero = Bad \"Err.mzero\"" ," mplus (Bad _) y = y" ," mplus x _ = x" ,"" ,"instance Alternative Err where" ," empty = mzero" ," (<|>) = mplus"]BNFC-2.8.1/src/BNFC/Backend/Haskell/CFtoAlex.hs0000644000000000000000000001601112654616013016635 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 BNFC.Backend.Haskell.CFtoAlex (cf2alex) where import BNFC.CF import BNFC.Backend.Haskell.RegToAlex import Data.List cf2alex :: String -> String -> CF -> String cf2alex name errMod cf = unlines $ intercalate [""] [ 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 ("$+-*=<>[](){}!?.,;:^~|&%#/\\$_@\"" :: String) restOfAlex :: CF -> [String] restOfAlex cf = [ "\"tokens_lx\"/\"tokens_acts\":-", lexComments (comments cf), "<> ::= ^w+", pTSpec (symbols cf,[]), -- modif Markus 12/02 - 2002 userDefTokenTypes, identAndRes, ifC catString " ::= ^\" ([^u # [^\"^\\^n]] | (^\\ (^\" | ^\\ | ^' | n | t)))* ^\"" ++ "%{ string p = PT p . TL . unescapeInitTail %}", ifC catChar " ::= ^\' (^u # [^\'^\\] | ^\\ [^\\ ^\' n t]) ^' %{ char p = PT p . TC %}", ifC catInteger " ::= ^d+ %{ int p = PT p . TI %}", ifC catDouble " ::= ^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 (_,[]) = " %s " aux ([],_) = " %r " aux (_,_) = " %s | %r " userDefTokenTypes = unlines [" ::= " ++ printRegAlex exp ++ "%{ mk_" ++ show name ++ " p = PT p . eitherResIdent T_" ++ show name ++ " %}" | (name,exp) <- tokenPragmas cf] userDefTokenConstrs = unlines [" | T_" ++ name ++ " String" | name <- tokenNames cf] userDefTokenPrint = unlines [" PT _ (T_" ++ name ++ " s) -> s" | name <- tokenNames 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) 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.8.1/src/BNFC/Backend/Haskell/RegToAlex.hs0000644000000000000000000000562312654616013017031 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 BNFC.Backend.Haskell.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 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.8.1/src/BNFC/Backend/Haskell/MkSharedString.hs0000644000000000000000000000500612654616013020057 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 BNFC.Backend.Haskell.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.8.1/src/BNFC/Backend/Haskell/CFtoTemplate.hs0000644000000000000000000001023512654616013017521 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 BNFC.Backend.Haskell.CFtoTemplate (cf2Template) where import BNFC.Backend.Haskell.Utils (catvars) import BNFC.CF import BNFC.PrettyPrint type ModuleName = String cf2Template :: ModuleName -> ModuleName -> ModuleName -> Bool -> CF -> String cf2Template skelName absName errName functor 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 (render . \(s,xs) -> case_fun functor s xs) $ specialData cf ++ cf2data cf ] {- ---- 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 False (Cat "Expr") [("EInt", [TokenCat "Integer"]), ("EAdd", [Cat "Expr", Cat "Expr"])] -- transExpr :: Expr -> Result -- transExpr x = case x of -- EInt integer -> failure x -- EAdd expr1 expr2 -> failure x -- -- >>> case_fun True (Cat "Expr") [("EInt", [TokenCat "Integer"]), ("EAdd", [Cat "Expr", Cat "Expr"])] -- transExpr :: Show a => Expr a -> Result -- transExpr x = case x of -- EInt _ integer -> failure x -- EAdd _ expr1 expr2 -> failure x -- -- TokenCat are not generated as functors: -- >>> case_fun True (TokenCat "MyIdent") [("MyIdent", [TokenCat "String"])] -- transMyIdent :: MyIdent -> Result -- transMyIdent x = case x of -- MyIdent string -> failure x case_fun :: Bool -> Cat -> [(Fun,[Cat])] -> Doc case_fun functor' cat xs = vcat [ fname <+> "::" <+> iffunctor "Show a =>" <+> type_ <+> "-> Result" , fname <+> "x = case x of" , nest 2 $ vcat (map mkOne xs) ] where -- If the functor option is set AND the category is not a token type, -- then the type is a functor. iffunctor doc | functor' && not (isTokenCat cat) = doc | otherwise = empty type_ = cat' <+> iffunctor "a" fname = "trans" <> cat' cat' = text (show cat) mkOne (cons, args) = let ns = catvars args -- names False (map (checkRes .var) args) 1 in text cons <+> iffunctor "_" <+> hsep ns <+> "-> failure x" BNFC-2.8.1/src/BNFC/Backend/Haskell/HsOpts.hs0000644000000000000000000001066712654616013016423 0ustar0000000000000000module BNFC.Backend.Haskell.HsOpts where import BNFC.Utils import BNFC.Options import System.FilePath (pathSeparator, (<.>)) import Data.List (intercalate) import Data.Maybe (catMaybes) type Options = SharedOptions alex1 opts = alexMode opts == Alex1 absFile, absFileM, alexFile, alexFileM, composOpFile, composOpFileM, gfAbs, happyFile, happyFileM, errFile, errFileM, templateFile, templateFileM, printerFile, printerFileM, layoutFile, layoutFileM, tFile :: Options -> String absFile = mkFile withLang "Abs" "hs" absFileM = mkMod withLang "Abs" alexFile = mkFile withLang "Lex" "x" alexFileM = mkMod withLang "Lex" happyFile = mkFile withLang "Par" "y" happyFileM = mkMod withLang "Par" txtFile = mkFile withLang "Doc" "txt" templateFile = mkFile withLang "Skel" "hs" templateFileM = mkMod withLang "Skel" printerFile = mkFile withLang "Print" "hs" printerFileM = mkMod withLang "Print" gfAbs = mkFile withLang "" "Abs.gf" tFile = mkFile withLang "Test" "hs" 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" xmlFile = mkFile withLang "XML" "hs" 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 ++ mkName [] CamelCase (lang opts) pkgToDir :: String -> FilePath pkgToDir s = replace '.' pathSeparator s -- | -- >>> mkMod withLang "Abstract" defaultOptions { lang = "abc" } -- "AbstractAbc" -- >>> mkMod noLang "Abstract" defaultOptions { lang = "abc" } -- "Abstract" -- >>> mkMod withLang "Abstract" defaultOptions { lang = "abc", inPackage = Just "A.B.C" } -- "A.B.C.AbstractAbc" -- >>> mkMod withLang "Abstract" defaultOptions { lang = "abc", inDir = True } -- "Abc.Abstract" -- >>> mkMod withLang "Abstract" defaultOptions { lang = "abc", inDir = True, inPackage = Just "A.B.C" } -- "A.B.C.Abc.Abstract" mkMod :: (Options -> String -> String) -> String -> Options -> String mkMod addLang name opts = mkNamespace opts <.> mod where [] <.> s = s s1 <.> s2 = s1 ++ "." ++ s2 mod | inDir opts = name | otherwise = addLang opts name -- | -- >>> mkFile withLang "Abstract" "hs" defaultOptions { lang = "abc" } -- "AbstractAbc.hs" -- >>> mkFile noLang "Abstract" "hs" defaultOptions { lang = "abc" } -- "Abstract.hs" -- >>> mkFile withLang "Abstract" "" defaultOptions { lang = "abc" } -- "AbstractAbc" -- >>> mkFile noLang "Abstract" "" defaultOptions { lang = "abc" } -- "Abstract" -- >>> mkFile withLang "Abstract" "hs" defaultOptions { lang = "abc", inDir = True } -- "Abc/Abstract.hs" -- >>> mkFile withLang "Abstract" "hs" defaultOptions { lang = "abc", inDir = True, inPackage = Just "A.B.C" } -- "A/B/C/Abc/Abstract.hs" mkFile :: (Options -> String -> String) -> String -> String -> Options -> FilePath mkFile addLang name ext opts = pkgToDir (mkMod addLang name opts) <.> ext mkFileName :: String -> String -> FilePath mkFileName module' ext = pkgToDir module' <.> ext -- | Determine the modules' namespace -- -- >>> mkNamespace defaultOptions -- "" -- >>> mkNamespace defaultOptions { lang = "Bla", inDir = True } -- "Bla" -- >>> mkNamespace defaultOptions { inPackage = Just "My.Cool.Package" } -- "My.Cool.Package" -- >>> mkNamespace defaultOptions { lang = "bla_bla", inDir = True } -- "BlaBla" -- >>> mkNamespace defaultOptions { lang = "bla", inDir = True, inPackage = Just "P"} -- "P.Bla" mkNamespace :: Options -> FilePath mkNamespace opts = intercalate "." $ catMaybes [inPackage opts, dir] where dir | inDir opts = Just (mkName [] CamelCase (lang opts)) | otherwise = Nothing -- | Determine the directory corresponding to the modules' namespace -- -- >>> codeDir defaultOptions -- "" -- >>> codeDir defaultOptions { lang = "Bla", inDir = True } -- "Bla" -- >>> codeDir defaultOptions { inPackage = Just "My.Cool.Package" } -- "My/Cool/Package" -- >>> codeDir defaultOptions { lang = "bla_bla", inDir = True } -- "BlaBla" -- >>> codeDir defaultOptions { lang = "bla", inDir = True, inPackage = Just "P"} -- "P/Bla" codeDir :: Options -> FilePath codeDir = pkgToDir . mkNamespace BNFC-2.8.1/src/BNFC/Backend/Haskell/CFtoAbstract.hs0000644000000000000000000001521412654616013017513 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 BNFC.Backend.Haskell.CFtoAbstract (cf2Abstract) where import BNFC.CF import BNFC.Utils((+++)) import BNFC.Backend.Haskell.Utils (catToType, catvars) import Text.PrettyPrint -- to produce a Haskell module cf2Abstract :: Bool -- ^ Use ByteString instead of String -> Bool -- ^ Use GHC specific extensions -> Bool -- ^ Make the tree a functor -> String -- ^ module name -> CF -- ^ Grammar -> String cf2Abstract byteStrings ghcExtensions functor name cf = unlines $ (if ghcExtensions then "{-# LANGUAGE DeriveDataTypeable #-}" else "") : (if ghcExtensions then "{-# LANGUAGE DeriveGeneric #-}" else "") : ("module "++name +++ "where\n") : "-- Haskell module generated by the BNF converter\n" : (if byteStrings then "import qualified Data.ByteString.Char8 as BS" else "") : (if ghcExtensions then "import Data.Data (Data,Typeable)" else "") : (if ghcExtensions then "import GHC.Generics (Generic)" else "") : (map (render . \c -> prSpecialData byteStrings (isPositionCat cf c) derivingClasses c) (specialCats cf) ++ map (render . prData functor derivingClasses) (cf2data cf)) where derivingClasses = ["Eq","Ord","Show","Read"] ++ if ghcExtensions then ["Data","Typeable","Generic"] else [] -- | >>> prData False ["Eq", "Ord", "Show", "Read"] (Cat "C", [("C1", [Cat "C"]), ("CIdent", [Cat "Ident"])]) -- data C = C1 C | CIdent Ident -- deriving (Eq, Ord, Show, Read) -- -- -- Nota that the layout adapts if it doesn't fit in a line: -- >>> prData False ["Show"] (Cat "C", [("CAbracadabra",[]),("CEbrecedebre",[]),("CIbricidibri",[]),("CObrocodobro",[]),("CUbrucudubru",[])]) -- data C -- = CAbracadabra -- | CEbrecedebre -- | CIbricidibri -- | CObrocodobro -- | CUbrucudubru -- deriving (Show) -- -- -- The if the first argument is True, generate a functor: -- >>> prData True ["Show"] (Cat "C", [("C1", [Cat "C"]), ("CIdent", [TokenCat "Ident"])]) -- data C a = C1 a (C a) | CIdent a Ident -- deriving (Show) -- -- instance Functor C where -- fmap f x = case x of -- C1 a c -> C1 (f a) (fmap f c) -- CIdent a ident -> CIdent (f a) ident -- -- The case for lists -- >>> prData True ["Show"] (Cat "ExpList", [("Exps", [ListCat (Cat "Exp")])]) -- data ExpList a = Exps a [Exp a] -- deriving (Show) -- -- instance Functor ExpList where -- fmap f x = case x of -- Exps a exps -> Exps (f a) (map (fmap f) exps) prData :: Bool -> [String] -> Data -> Doc prData functor derivingClasses (cat,rules) = hang ("data" <+> dataType) 4 (constructors rules) $+$ nest 2 (deriving_ derivingClasses) $+$ "" $+$ if functor then genFunctorInstance (cat, rules) else empty where prRule (fun,cats) = hsep $ concat [[text fun], ["a" | functor], map prArg cats] dataType = if functor then text (show cat) <+> "a" else text (show cat) prArg c = catToType (if functor then Just "a" else Nothing) c constructors [] = empty constructors (h:t) = sep ("=" <+> prRule h : map (("|" <+>) . prRule) t) -- | Generate a functor instance declaration: -- >>> genFunctorInstance (Cat "C", [("C1", [Cat "C", Cat "C"]), ("CIdent", [TokenCat "Ident"])]) -- instance Functor C where -- fmap f x = case x of -- C1 a c1 c2 -> C1 (f a) (fmap f c1) (fmap f c2) -- CIdent a ident -> CIdent (f a) ident -- >>> genFunctorInstance (Cat "SomeLists", [("Ints", [ListCat (TokenCat "Integer")]), ("Exps", [ListCat (Cat "Exp")])]) -- instance Functor SomeLists where -- fmap f x = case x of -- Ints a integers -> Ints (f a) integers -- Exps a exps -> Exps (f a) (map (fmap f) exps) -- genFunctorInstance :: Data -> Doc genFunctorInstance (cat, cons) = "instance Functor" <+> text (show cat) <+> "where" $+$ nest 4 ( "fmap f x = case x of" $+$ nest 4 (vcat (map mkCase cons))) where mkCase (f,args) = let variables = catvars args in text f <+> "a" <+> hsep variables <+> "->" <+> text f <+> "(f a)" <+> hsep (map reccurse (zip args variables)) -- We reccursively call fmap on non-terminals only if they are not -- token categories reccurse (TokenCat _, var) = var reccurse (ListCat (TokenCat _), var) = var reccurse (ListCat _, var) = parens ("map (fmap f)" <+> var) reccurse (_, var) = parens ("fmap f" <+> var) -- | Generate a newtype declaration for Ident types -- -- >>> prSpecialData False False ["Show"] (Cat "Ident") -- newtype Ident = Ident String deriving (Show) -- -- >>> prSpecialData False True ["Show"] (Cat "Ident") -- newtype Ident = Ident ((Int,Int),String) deriving (Show) -- -- >>> prSpecialData True False ["Show"] (Cat "Ident") -- newtype Ident = Ident BS.ByteString deriving (Show) -- -- >>> prSpecialData True True ["Show"] (Cat "Ident") -- newtype Ident = Ident ((Int,Int),BS.ByteString) deriving (Show) prSpecialData :: Bool -- ^ If True, use ByteString instead of String -> Bool -- ^ If True, store the token position -> [String] -- ^ Derived classes -> Cat -- ^ Category -> Doc prSpecialData byteStrings position classes cat = hang newtype_ 2 (deriving_ classes) where ppcat = text (show cat) newtype_ = "newtype" <+> ppcat <+> "=" <+> ppcat <+> contentSpec contentSpec | position = parens ( "(Int,Int)," <> stringType) | otherwise = stringType stringType | byteStrings = "BS.ByteString" | otherwise = "String" -- | Generate 'deriving' clause -- >>> deriving_ ["Show","Read"] -- deriving (Show, Read) deriving_ :: [String] -> Doc deriving_ cls = "deriving" <+> parens (hsep (punctuate "," (map text cls))) BNFC-2.8.1/src/BNFC/Backend/Haskell/CFtoAlex3.hs0000644000000000000000000003352612654616013016732 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 BNFC.Backend.Haskell.CFtoAlex3 (cf2alex3) where import BNFC.CF import Data.List -- For BNFC.Backend.Haskell.RegToAlex, see below. import AbsBNF import Data.Char cf2alex3 :: String -> String -> String -> Bool -> Bool -> CF -> String cf2alex3 name errMod shareMod shareStrings byteStrings cf = unlines $ intercalate [""] [ prelude name errMod shareMod shareStrings byteStrings, cMacros, rMacros cf, restOfAlex shareMod shareStrings byteStrings cf ] prelude :: String -> String -> String -> Bool -> Bool -> [String] prelude name _ shareMod shareStrings byteStrings = [ "-- -*- haskell -*-", "-- This Alex file was machine-generated by the BNF converter", "{", "{-# OPTIONS -fno-warn-incomplete-patterns #-}", "{-# OPTIONS_GHC -w #-}", "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)", "import Data.Char (ord)", "}", "" ] 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 _ shareStrings byteStrings cf = [ ":-", lexComments (comments cf), "$white+ ;", pTSpec (symbols cf), userDefTokenTypes, ident, ifC catString ("\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t)))* \\\"" ++ "{ tok (\\p s -> PT p (TL $ share $ unescapeInitTail s)) }"), ifC catChar "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t]) \\' { tok (\\p s -> PT p (TC $ share s)) }", ifC catInteger "$d+ { tok (\\p s -> PT p (TI $ share s)) }", ifC catDouble "$d+ \\. $d+ (e (\\-)? $d+)? { tok (\\p s -> PT p (TD $ share s)) }", "", "{", "", "tok :: (Posn -> String -> Token) -> (Posn -> String -> Token)", "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 :: [Token] -> String", "tokenPos (PT (Pn _ l _) _ :_) = \"line \" ++ show l", "tokenPos (Err (Pn _ l _) :_) = \"line \" ++ show l", "tokenPos _ = \"end of file\"", "", "tokenPosn :: Token -> Posn", "tokenPosn (PT p _) = p", "tokenPosn (Err p) = p", "", "tokenLineCol :: Token -> (Int, Int)", "tokenLineCol = posLineCol . tokenPosn", "", "posLineCol :: Posn -> (Int, Int)", "posLineCol (Pn _ l c) = (l,c)", "", "mkPosToken :: Token -> ((Int, Int), String)", "mkPosToken t@(PT p _) = (posLineCol p, prToken t)", "", "prToken :: Token -> String", "prToken t = case t of", " PT _ (TS s _) -> s", " PT _ (TL s) -> show 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 :: BTree", "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? r1:"] | \\", r1:"+ [$u # [\\", r1:" \\", 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_" ++ show name ++ " . share) s)) }" | (name,exp) <- tokenPragmas cf] userDefTokenConstrs = unlines [" | T_" ++ name ++ " !"++stringType | name <- tokenNames cf] userDefTokenPrint = unlines [" PT _ (T_" ++ name ++ " s) -> s" | name <- tokenNames 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 @BNFC.Backend.Haskell.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 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 = concatMap (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = case c of '\n' -> ["\\n"] '\t' -> ["\\t"] c | isAlphaNum c -> [[c]] c | isPrint c -> ['\\':[c]] c -> ['\\':show (ord c)] prtList = map (concat . prt 0) prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (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 (prt 3 reg ++ ["*"]) RPlus reg -> prPrec i 3 (prt 3 reg ++ ["+"]) ROpt reg -> prPrec i 3 (prt 3 reg ++ ["?"]) REps -> prPrec i 3 ["()"] RChar c -> prPrec i 3 (prt 0 c) RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]]) RSeqs str -> prPrec i 2 (concatMap (prt 0) str) RDigit -> prPrec i 3 ["$d"] RLetter -> prPrec i 3 ["$l"] RUpper -> prPrec i 3 ["$c"] RLower -> prPrec i 3 ["$s"] RAny -> prPrec i 3 ["$u"] BNFC-2.8.1/src/BNFC/Backend/Haskell/Utils.hs0000644000000000000000000000577712654616013016311 0ustar0000000000000000module BNFC.Backend.Haskell.Utils ( parserName , hsReservedWords , catToType , catvars ) where import Text.PrettyPrint import BNFC.CF (Cat(..), identCat, normCat) import BNFC.Utils (mkNames, NameStyle(..)) -- | Create a valid parser function name for a given category -- >>> parserName (Cat "Abcd") -- pAbcd -- >>> parserName (ListCat (Cat "Xyz")) -- pListXyz parserName :: Cat -> Doc parserName = ("p" <>) . text . identCat -- | Haskell's reserved words hsReservedWords :: [String] hsReservedWords = [ "as" , "case" , "class" , "data" , "default" , "deriving" , "do" , "else" , "hiding" , "if" , "import" , "in" , "infix" , "infixl" , "infixr" , "instance" , "let" , "module" , "newtype" , "of" , "qualified" , "then" , "type" , "where" ] -- | Render a category from the grammar to a Haskell type -- >>> catToType Nothing (Cat "A") -- A -- >>> catToType Nothing (ListCat (Cat "A")) -- [A] -- >>> catToType Nothing (TokenCat "Ident") -- Ident -- -- Note that there is no haskell type for coerced categories: they should be -- normalized -- >>> catToType Nothing (CoercCat "Expr" 2) -- Expr -- -- If a type parameter is given it is added to the type name: -- >>> catToType (Just "a") (Cat "A") -- (A a) -- -- >>> catToType (Just "a") (ListCat (Cat "A")) -- [A a] -- -- but not added to Token categories: -- >>> catToType (Just "a") (TokenCat "Integer") -- Integer -- -- >>> catToType (Just "a") (ListCat (TokenCat "Integer")) -- [Integer] -- -- >>> catToType Nothing (ListCat (CoercCat "Exp" 2)) -- [Exp] -- -- >>> catToType (Just "()") (ListCat (CoercCat "Exp" 2)) -- [Exp ()] catToType :: Maybe Doc -> Cat -> Doc catToType param cat = maybeParens $ catToType' param cat where maybeParens = case (param,cat) of (Just _, Cat _) -> parens _ -> id catToType' _ InternalCat = error "Can't create a haskell type for internal category" catToType' Nothing c = text $ show $ normCat c catToType' (Just p) (Cat c) = text c <+> p catToType' (Just p) (CoercCat c _) = text c <+> p catToType' (Just _) (TokenCat c) = text c catToType' (Just p) (ListCat c) = lbrack <> catToType' (Just p) c <> rbrack -- | gives you a list of variables usable for pattern matching. -- Ex: if you have the rule Aba. S ::= A B A ; with the generated data type -- data S = Aba A B A -- Given the lit of categories in the RHS of the rule (A B A), we generate the -- list [a1,b,a2] to be used in a pattern matching like -- case s of -- Aba a1 b a2 -> ... -- ... -- -- >>> catvars [Cat "A", Cat "B", Cat "A"] -- [a1,b,a2] -- -- It should avoid reserved words -- >>> catvars [Cat "IF", Cat "Case", Cat "Type", Cat "If"] -- [if_1,case_,type_,if_2] -- -- It uses an -s to mark lists: -- >>> catvars [Cat "A", ListCat (Cat "A"), ListCat (ListCat (Cat "A"))] -- [a,as_,ass] catvars :: [Cat] -> [Doc] catvars = map text . mkNames hsReservedWords LowerCase . map var where var (ListCat c) = var c ++ "s" var xs = show xs BNFC-2.8.1/src/BNFC/Backend/Haskell/CFtoHappy.hs0000644000000000000000000002731312654616013017034 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 BNFC.Backend.Haskell.CFtoHappy (cf2HappyS, convert) where import BNFC.CF import BNFC.Backend.Common.StrUtils (escapeChars) import BNFC.Backend.Haskell.Utils (parserName, catToType) --import Lexer import Data.Char import BNFC.Options (HappyMode(..)) import BNFC.PrettyPrint -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] type Pattern = String type Action = String type MetaVar = String -- default naming tokenName = "Token" -- Happy mode cf2HappyS :: String -- ^ This module's name -> String -- ^ Abstract syntax module name -> String -- ^ Lexer module name -> String -- ^ ErrM module name -> HappyMode -- ^ Happy mode -> Bool -- ^ Use bytestring? -> Bool -- ^ AST is a functor? -> CF -- ^ Grammar -> String -- ^ Generated code ---- 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 functor cf = unlines [header name absName lexName errName mode byteStrings, render $ declarations mode (allEntryPoints cf), tokens (cfTokens cf), specialToks cf, delimiter, specialRules byteStrings cf, render $ prRules functor (rulesForHappy absName functor 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 "", "}" ] -- | The declarations of a happy file. -- >>> declarations Standard [Cat "A", Cat "B", ListCat (Cat "B")] -- %name pA A -- %name pB B -- %name pListB ListB -- -- no lexer declaration -- %monad { Err } { thenM } { returnM } -- %tokentype {Token} declarations :: HappyMode -> [Cat] -> Doc declarations mode ns = vcat [ vcat $ map generateP ns , case mode of Standard -> "-- no lexer declaration" GLR -> "%lexer { myLexer } { Err _ }", "%monad { Err } { thenM } { returnM }", "%tokentype" <+> braces (text tokenName) ] where generateP n = "%name" <+> parserName n <+> text n' 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) = " " ++ render (convert t) ++ " { " ++ oneTok t k ++ " }\n" ++ prTokens tk oneTok _ 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 -> Doc convert = quotes . text . escapeChars rulesForHappy :: String -> Bool -> CF -> Rules rulesForHappy absM functor cf = map mkOne $ ruleGroups cf where mkOne (cat,rules) = (cat, map (constructRule absM functor reversibles) rules) reversibles = reversibleCats cf -- | 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 "Foo" False [] (Rule "EPlus" (Cat "Exp") [Left (Cat "Exp"), Right "+", Left (Cat "Exp")]) -- ("Exp '+' Exp","Foo.EPlus $1 $3") -- -- If we're using functors, it adds an void value: -- >>> constructRule "Foo" True [] (Rule "EPlus" (Cat "Exp") [Left (Cat "Exp"), Right "+", Left (Cat "Exp")]) -- ("Exp '+' Exp","Foo.EPlus () $1 $3") -- -- List constructors should not be prefixed by the abstract module name: -- >>> constructRule "Foo" False [] (Rule "(:)" (ListCat (Cat "A")) [Left (Cat "A"), Right",", Left (ListCat (Cat "A"))]) -- ("A ',' ListA","(:) $1 $3") -- >>> constructRule "Foo" False [] (Rule "(:[])" (ListCat (Cat "A")) [Left (Cat "A")]) -- ("A","(:[]) $1") -- -- Coercion are much simpler: -- >>> constructRule "Foo" True [] (Rule "_" (Cat "Exp") [Right "(", Left (Cat "Exp"), Right ")"]) -- ("'(' Exp ')'","$2") -- -- 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 "Foo" False [ListCat (Cat "A")] (Rule "(:)" (ListCat (Cat "A")) [Left (Cat "A"), Right",", Left (ListCat (Cat "A"))]) -- ("ListA A ','","flip (:) $1 $2") -- -- Note that functors don't concern list constructors: -- >>> constructRule "Abs" True [ListCat (Cat "A")] (Rule "(:)" (ListCat (Cat "A")) [Left (Cat "A"), Right",", Left (ListCat (Cat "A"))]) -- ("ListA A ','","flip (:) $1 $2") constructRule :: String -> Bool -> [Cat] -> Rule -> (Pattern,Action) constructRule absName functor revs r0@(Rule fun cat _) = (pattern, action) where (pattern,metavars) = generatePatterns revs r action | isCoercion fun = unwords metavars | isConsFun fun && elem cat revs = unwords ("flip" : fun : metavars) | isNilCons fun = unwords (underscore fun : metavars) | functor = unwords (underscore fun : "()" : metavars) | otherwise = unwords (underscore fun : metavars) r | isConsFun (funRule r0) && elem (valCat r0) revs = revSepListRule r0 | otherwise = r0 underscore f | isConsFun f || isNilCons f = f | isDefinedRule f = absName ++ "." ++ f ++ "_" | otherwise = absName ++ "." ++ f -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: [Cat] -> Rule -> (Pattern,[MetaVar]) generatePatterns revs 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 -> render (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 -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. -- | -- >>> prRules False [(Cat "Expr", [("Integer", "EInt $1"), ("Expr '+' Expr", "EPlus $1 $3")])] -- Expr :: { Expr } -- Expr : Integer { EInt $1 } | Expr '+' Expr { EPlus $1 $3 } -- -- if there's a lot of cases, print on several lignes: -- >>> prRules False [(Cat "Expr", [("Abcd", "Action"), ("P2", "A2"), ("P3", "A3"), ("P4", "A4"), ("P5","A5")])] -- Expr :: { Expr } -- Expr : Abcd { Action } -- | P2 { A2 } -- | P3 { A3 } -- | P4 { A4 } -- | P5 { A5 } -- -- >>> prRules False [(Cat "Internal", [])] -- nt has only internal use -- -- -- The functor case: -- >>> prRules True [(Cat "Expr", [("Integer", "EInt () $1"), ("Expr '+' Expr", "EPlus () $1 $3")])] -- Expr :: { (Expr ()) } -- Expr : Integer { EInt () $1 } | Expr '+' Expr { EPlus () $1 $3 } -- -- A list with coercion: in the type signature we need to get rid of the -- coercion -- >>> prRules True [(ListCat (CoercCat "Exp" 2), [("Exp2", "(:[]) $1"), ("Exp2 ',' ListExp2","(:) $1 $3")])] -- ListExp2 :: { [Exp ()] } -- ListExp2 : Exp2 { (:[]) $1 } | Exp2 ',' ListExp2 { (:) $1 $3 } prRules :: Bool -> Rules -> Doc prRules functor = vcat . map prOne where type' = catToType (if functor then Just "()" else Nothing) prOne (_,[]) = empty -- nt has only internal use prOne (nt,(p,a):ls) = hsep [ nt', "::", "{", type' nt, "}" ] $$ nt' <+> sep (pr ":" (p, a) : map (pr "|") ls) where nt' = text (identCat nt) pr pre (p,a) = hsep [pre, text p, "{", text a , "}"] -- 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)) where aux cat = case show 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 show 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.8.1/src/BNFC/Backend/Haskell/CFtoPrinter.hs0000644000000000000000000002575112654616013017402 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 BNFC.Backend.Haskell.CFtoPrinter (cf2Printer, compareRules) where import BNFC.Backend.Haskell.Utils (hsReservedWords) import BNFC.CF import BNFC.Utils import Data.Char(toLower) import Data.Either (lefts) import Data.List (sortBy) import Data.Maybe (fromJust) import Text.PrettyPrint -- derive pretty-printer from a BNF grammar. AR 15/2/2002 cf2Printer :: Bool -> Bool -> Bool -> String -> String -> CF -> String cf2Printer byteStrings functor useGadt name absMod cf = unlines [ prologue byteStrings useGadt name absMod, integerRule cf, doubleRule cf, if hasIdent cf then identRule byteStrings cf else "", unlines [ownPrintRule byteStrings cf own | (own,_) <- tokenPragmas cf], rules functor cf ] prologue :: Bool -> Bool -> String -> String -> String prologue byteStrings useGadt name absMod = unlines $ ["{-# LANGUAGE GADTs, TypeSynonymInstances, FlexibleInstances #-}" | useGadt] ++ [ "{-# 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 :: Int -> [a] -> Doc", " prtList i = concatD . map (prt i)", "", "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 CF -> String rules functor cf = unlines $ map (\(s,xs) -> render (case_fun functor s (map toArgs xs)) ++++ ifList cf s) $ cf2data cf where toArgs (cons,_) = (cons, ruleOf cons) ruleOf s = fromJust $ lookupRule s (rulesOfCF cf) -- | -- >>> case_fun False (Cat "A") [("AA", (Cat "AB", [Right "xxx"]))] -- instance Print A where -- prt i e = case e of -- AA -> prPrec i 0 (concatD [doc (showString "xxx")]) case_fun :: Bool -> Cat -> [(String, (Cat, [Either Cat String]))] -> Doc case_fun functor cat xs = vcat [ "instance Print" <+> type_ <+> "where" , nest 2 $ vcat [ "prt i e = case e of" , nest 2 $ vcat (map (mkPrintCase functor) xs) ] ] where type_ | functor = parens (text (show cat) <+> "a") | otherwise = text (show cat) -- When writing the Print instance for a category (in case_fun), we have -- a different case for each constructor for this category. -- >>> mkPrintCase False ("AA", (Cat "A", [Right "xxx"])) -- AA -> prPrec i 0 (concatD [doc (showString "xxx")]) -- -- Coercion levels are passed to prPrec -- >>> mkPrintCase False ("EInt", (CoercCat "Expr" 2, [Left (TokenCat "Integer")])) -- EInt n -> prPrec i 2 (concatD [prt 0 n]) -- >>> mkPrintCase False ("EPlus", (CoercCat "Expr" 1, [Left (Cat "Expr"), Right "+", Left (Cat "Expr")])) -- EPlus expr0 expr -> prPrec i 1 (concatD [prt 0 expr0, doc (showString "+"), prt 0 expr]) -- -- If the AST is a functor, ignore first argument -- >>> mkPrintCase True ("EInt", (CoercCat "Expr" 2, [Left (TokenCat "Integer")])) -- EInt _ n -> prPrec i 2 (concatD [prt 0 n]) -- -- Skip intertal categories -- >>> mkPrintCase True ("EInternal", (Cat "Expr", [Left InternalCat, Left (Cat "Expr")])) -- EInternal _ expr -> prPrec i 0 (concatD [prt 0 expr]) mkPrintCase :: Bool -> (Fun, (Cat, [Either Cat String])) -> Doc mkPrintCase functor (f, (cat, rhs)) = text f <+> (if functor then "_" else empty) <+> hsep variables <+> "->" <+> "prPrec i" <+> integer (precCat cat) <+> mkRhs (map render variables) rhs where -- Creating variables names used in pattern matching. In addition to -- haskell's reserved words, `e` and `i` are used in the printing function -- and should be avoided names = map var (filter (/=InternalCat) $ lefts rhs) variables = map text $ mkNames ("e":"i":hsReservedWords) LowerCase names var (ListCat c) = var c ++ "s" var (TokenCat "Ident") = "id" var (TokenCat "Integer") = "n" var (TokenCat "String") = "str" var (TokenCat "Char") = "c" var (TokenCat "Double") = "d" var xs = map toLower $ show xs ifList :: CF -> Cat -> String ifList cf cat = render $ nest 2 $ vcat [ mkPrtListCase r | r <- rules ] where rules = sortBy compareRules $ rulesForNormalizedCat cf (ListCat cat) -- | Pattern match on the list constructor and the coercion level -- >>> mkPrtListCase (Rule "[]" (ListCat (Cat "Foo")) []) -- prtList _ [] = (concatD []) -- >>> mkPrtListCase (Rule "(:[])" (ListCat (Cat "Foo")) [Left (Cat "FOO")]) -- prtList _ [x] = (concatD [prt 0 x]) -- >>> mkPrtListCase (Rule "(:)" (ListCat (Cat "Foo")) [Left (Cat "Foo"), Left (ListCat (Cat "Foo"))]) -- prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs]) -- >>> mkPrtListCase (Rule "[]" (ListCat (CoercCat "Foo" 2)) []) -- prtList 2 [] = (concatD []) -- >>> mkPrtListCase (Rule "(:[])" (ListCat (CoercCat "Foo" 2)) [Left (CoercCat "Foo" 2)]) -- prtList 2 [x] = (concatD [prt 2 x]) -- >>> mkPrtListCase (Rule "(:)" (ListCat (CoercCat "Foo" 2)) [Left (CoercCat "Foo" 2), Left (ListCat (CoercCat "Foo" 2))]) -- prtList 2 (x:xs) = (concatD [prt 2 x, prt 2 xs]) mkPrtListCase :: Rule -> Doc mkPrtListCase (Rule f (ListCat c) rhs) | isNilFun f = "prtList" <+> precPattern <+> "[]" <+> "=" <+> body | isOneFun f = "prtList" <+> precPattern <+> "[x]" <+> "=" <+> body | isConsFun f = "prtList" <+> precPattern <+> "(x:xs)" <+> "=" <+> body | otherwise = empty -- (++) constructor where precPattern = case precCat c of 0 -> "_" ; p -> integer p body = mkRhs ["x", "xs"] rhs -- | Define an ordering on lists' rules with the following properties: -- - rules with a higher coercion level should come first, i.e. the rules for -- [Foo3] are before rules for [Foo1] and they are both lower than rules for -- [Foo]. -- - [] < [_] < _:_ -- This is desiged to correctly order the rules in the prtList function so that -- the pattern matching works as expectd. -- -- >>> compareRules (Rule "[]" (ListCat (CoercCat "Foo" 3)) []) (Rule "[]" (ListCat (CoercCat "Foo" 1)) []) -- LT -- >>> compareRules (Rule "[]" (ListCat (CoercCat "Foo" 3)) []) (Rule "[]" (ListCat (Cat "Foo")) []) -- LT -- >>> compareRules (Rule "[]" (ListCat (Cat "Foo")) []) (Rule "(:[])" (ListCat (Cat "Foo")) []) -- LT -- >>> compareRules (Rule "(:[])" (ListCat (Cat "Foo")) []) (Rule "(:)" (ListCat (Cat "Foo")) []) -- LT compareRules :: Rule -> Rule -> Ordering compareRules r1 r2 | precRule r1 > precRule r2 = LT compareRules r1 r2 | precRule r1 < precRule r2 = GT compareRules (Rule "[]" _ _) (Rule "[]" _ _) = EQ compareRules (Rule "[]" _ _) _ = LT compareRules (Rule "(:[])" _ _) (Rule "[]" _ _) = GT compareRules (Rule "(:[])" _ _) (Rule "(:[])" _ _) = EQ compareRules (Rule "(:[])" _ _) (Rule "(:)" _ _) = LT compareRules (Rule "(:)" _ _) (Rule "(:)" _ _) = EQ compareRules (Rule "(:)" _ _) _ = GT compareRules _ _ = EQ -- | -- >>> mkRhs ["expr1", "n", "expr2"] [Left (Cat "Expr"), Right "-", Left (TokenCat "Integer"), Left (Cat "Expr")] -- (concatD [prt 0 expr1, doc (showString "-"), prt 0 n, prt 0 expr2]) -- -- Coercions on the right hand side should be passed to prt: -- >>> mkRhs ["expr1"] [Left (CoercCat "Expr" 2)] -- (concatD [prt 2 expr1]) -- >>> mkRhs ["expr2s"] [Left (ListCat (CoercCat "Expr" 2))] -- (concatD [prt 2 expr2s]) mkRhs :: [String] -> [Either Cat String] -> Doc mkRhs args its = parens ("concatD" <+> brackets (hsep (punctuate "," (mk args its)))) where mk args (Left InternalCat : items) = mk args items mk (arg:args) (Left c : items) = (prt c <+> text arg) : mk args items mk args (Right s : items) = ("doc (showString" <+> text (show s) <> ")") : mk args items mk _ _ = [] prt c = "prt" <+> integer (precCat c) BNFC-2.8.1/src/BNFC/Backend/Haskell/CFtoAlex2.hs0000644000000000000000000003043312654616013016723 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 : BNFC.Backend.Haskell.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 @BNFC.Backend.Haskell.CFtoAlex@ to cope with Alex2. -- ------------------------------------------------------------------- module BNFC.Backend.Haskell.CFtoAlex2 (cf2alex2) where import BNFC.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 $ intercalate [""] [ prelude name errMod shareMod shareStrings byteStrings, cMacros, rMacros cf, restOfAlex shareMod shareStrings byteStrings cf ] prelude :: String -> String -> String -> Bool -> Bool -> [String] prelude name _ 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 _ shareStrings byteStrings cf = [ ":-", lexComments (comments cf), "$white+ ;", pTSpec (symbols cf), userDefTokenTypes, ident, ifC catString ("\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t)))* \\\"" ++ "{ tok (\\p s -> PT p (TL $ share $ unescapeInitTail s)) }"), ifC catChar "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t]) \\' { tok (\\p s -> PT p (TC $ share s)) }", ifC catInteger "$d+ { tok (\\p s -> PT p (TI $ share s)) }", ifC catDouble "$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) -> show 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? r1:"] | \\", r1:"+ [$u # [\\", r1:" \\", 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_" ++ show name ++ " . share) s)) }" | (name,exp) <- tokenPragmas cf] userDefTokenConstrs = unlines [" | T_" ++ name ++ " !"++stringType | name <- tokenNames cf] userDefTokenPrint = unlines [" PT _ (T_" ++ name ++ " s) -> s" | name <- tokenNames 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 @BNFC.Backend.Haskell.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 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 = concatMap (prt 0) instance Print a => Print [a] where prt _ = prtList instance Print Char where prt _ c = if isAlphaNum c then [[c]] else ['\\':[c]] prtList = map (concat . prt 0) prPrec :: Int -> Int -> [String] -> [String] prPrec i j = if j prPrec i 2 (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 (prt 3 reg ++ ["*"]) RPlus reg -> prPrec i 3 (prt 3 reg ++ ["+"]) ROpt reg -> prPrec i 3 (prt 3 reg ++ ["?"]) REps -> prPrec i 3 ["()"] RChar c -> prPrec i 3 (prt 0 c) RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]]) RSeqs str -> prPrec i 2 (concatMap (prt 0) str) RDigit -> prPrec i 3 ["$d"] RLetter -> prPrec i 3 ["$l"] RUpper -> prPrec i 3 ["$c"] RLower -> prPrec i 3 ["$s"] RAny -> prPrec i 3 ["$u"] BNFC-2.8.1/src/BNFC/Backend/Haskell/ToCNF.hs0000644000000000000000000002131512654616013016104 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 BNFC.Backend.Haskell.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 BNFC.ToCNFCore import BNFC.CF hiding (App,Exp) import BNFC.Backend.Haskell.HsOpts import Control.Monad.RWS import Control.Applicative hiding (Const) import qualified Data.Map as M import Data.Pair import Text.PrettyPrint.HughesPJ hiding (first,(<>)) -- Code generation incomment x = "{-" <> x <> "-}" generate opts cf0 = render $ vcat [header opts ,genShowFunction cf0 ,genCatTags cf1 ,genDesc cf1 descriptions ,genNeighborSet neighbors ,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,neighbors) = 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 $ show x pretty (Right x) = quotes $ text x instance Pretty String where pretty = text prettyUnitSet units = vcat [prettyExp f <> " : " <> catTag cat <> " --> " <> text (show 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)" ] genShowFunction cf = hang "showAst (cat,ast) = case cat of " 6 (vcat [catTag (Left cat) <> " -> printTree ((unsafeCoerce# ast)::" <> text (show 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 <> " = " <> text (show (descOf s)) | s <- allSyms cf] where descOf :: Either Cat String -> String descOf (Right x) = "token " <> x descOf (Left x) = maybe (show x) render $ 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 Cat 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#") 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') <- lookupMulti (Left c) units] args = map (unsafeCoerce' . Con) $ ["x"|isCat r1]++["y"|isCat r2] alt _ _ = error "Only works with binary rules" 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 = (catChar,"TC",Con "head"): (catString,"TL",Id): (catInteger,"TI",Con "readInteger"): (catDouble,"TD",Con "readDouble"): [(catIdent,"TV",Con "Ident")|hasIdent cf] ++ [(t,"T_" <> text (show t),(Con (show t))) | (t,_) <- tokenPragmas 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) <- lookupMulti (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) <- lookupMulti (Right tok) units] tokVal = "error" <> (text $ show $ "cannot access value of token: " ++ tok) ppList = brackets . punctuate' ", " genNeighborSet ns = vcat ["neighbors " <> catTag x <> " = " <> ppList (map catTag y) | (x,y) <- ns] $$ "neighbors _ = []" ------------------------ -- Test file generation genTestFile opts _ = 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!!!" ] BNFC-2.8.1/src/BNFC/Backend/C/0000755000000000000000000000000012654616013013434 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/C/CFtoFlexC.hs0000644000000000000000000001507412654616013015554 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 BNFC.Backend.C.CFtoFlexC (cf2flex) where import BNFC.CF import BNFC.Backend.CPP.NoSTL.RegToFlex import BNFC.Backend.Common.NamedVariables --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 (tokenNames 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", "extern int yy_mylinenumber ;", "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 catString strStates, ifC catChar chStates, ifC catDouble "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t yylval.double_ = atof(yytext); return _DOUBLE_;\n", ifC catInteger "{DIGIT}+ \t yylval.int_ = atoi(yytext); return _INTEGER_;\n", ifC catIdent "{LETTER}{IDENT}* \t yylval.string_ = strdup(yytext); return _IDENT_;\n", "\\n ++yy_mylinenumber ;\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 (show n) env of Just x -> x Nothing -> show 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) { yyrestart(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 ++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 :: (String, String) -> String lexMultiComment (b,e) = unlines [ "\"" ++ b ++ "\" \t BEGIN COMMENT;", "\"" ++ e ++ "\" \t BEGIN YYINITIAL;", ". \t /* BNFC multi-line comment */;", "[\\n] ++yy_mylinenumber ; \t /* BNFC multi-line comment */;" ] --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.8.1/src/BNFC/Backend/C/CFtoCAbs.hs0000644000000000000000000002427612654616013015367 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 BNFC.Backend.C.CFtoCAbs (cf2CAbs) where import BNFC.CF import BNFC.PrettyPrint import BNFC.Utils((+++)) import BNFC.Backend.Common.NamedVariables import Data.Function (on) import Data.List import Data.Char(toLower) --The result is two files (.H file, .C file) cf2CAbs :: String -> CF -> (String, String) cf2CAbs _ 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 (getAbstractSyntax cf), "", "#endif" ] where user = fst (unzip (tokenPragmas cf)) header = "/* C++ Abstract Syntax Interface generated by the BNF Converter.*/\n" rules = getRules cf classes = nub (rules ++ getClasses (allCats cf)) prForward s | not (isCoercion s) = unlines [ "struct " ++ s ++ "_;", "typedef struct " ++ s ++ "_ *" ++ s ++ ";" ] prForward _ = "" getRules cf = (map testRule (rulesOfCF cf)) getClasses = map show . filter (\c -> identCat (normCat c) == show c) testRule (Rule f c _) = if isList c then if isConsFun f then identCat (normCat c) else "_" --ignore this else "_" -- | Prints struct definitions for all categories. prDataH :: Data -> String prDataH (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 " ++ show cat ++ "_", "{", " enum { " ++ intercalate ", " (map prKind rules) ++ " } kind;", " union", " {", concatMap prUnion rules ++ " } u;", "};", "", concatMap (prRuleH cat) rules ] where c' = identCat (normCat cat) mem = identCat (normCatOfList cat) prKind (fun, _) = "is_" ++ fun prUnion (_, []) = "" prUnion (fun, cats) = " struct { " ++ (render $ prInstVars (getVars cats)) ++ " } " ++ (memName fun) ++ ";\n" --Interface definitions for rules vary on the type of rule. prRuleH :: Cat -> (Fun, [Cat]) -> String prRuleH c (fun, cats) = if isNilFun fun || isOneFun fun || isConsFun fun then "" --these are not represented in the AbSyn else --a standard rule show c ++ " make_" ++ fun ++ "(" ++ (prParamsH 0 (getVars cats)) ++ ");\n" where 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* " ++ show s ++ ";\n" -- | A class's instance variables. Print the variables declaration by grouping -- together the variables of the same type. -- >>> prInstVars [("A", 1)] -- A a_1; -- >>> prInstVars [("A",1),("A",2),("B",1)] -- A a_1, a_2; B b_1; prInstVars :: [IVar] -> Doc prInstVars = hsep . map prInstVarsOneType . groupBy ((==) `on` fst) . sort where prInstVarsOneType ivars = text (fst (head ivars)) <+> hsep (punctuate comma (map prIVar ivars)) <> semi prIVar (s, i) = text (varName s) <> text (showNum i) {- **** Implementation (.C) File Functions **** -} --Makes the .C file mkCFile :: CF -> String mkCFile cf = unlines [ header, concatMap (render . prDataC) (getAbstractSyntax cf) ] where 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 :: Data -> Doc prDataC (cat, rules) = vsep $ map (prRuleC cat) rules -- | Classes for rules vary based on the type of rule. -- -- * Empty list constructor, these are not represented in the AbSyn -- >>> prRuleC (ListCat (Cat "A")) ("[]", [Cat "A", Cat "B", Cat "B"]) -- -- -- * Linked list case. These are all built-in list functions. -- Later we could include things like lookup,insert,delete,etc. -- >>> prRuleC (ListCat (Cat "A")) ("(:)", [Cat "A", Cat "B", Cat "B"]) -- /******************** ListA ********************/ -- ListA make_ListA(A p1, ListA p2) -- { -- ListA tmp = (ListA) malloc(sizeof(*tmp)); -- if (!tmp) -- { -- fprintf(stderr, "Error: out of memory when allocating ListA!\n"); -- exit(1); -- } -- tmp->a_ = p1; -- tmp->lista_ = p2; -- return tmp; -- } -- -- * Standard rule -- >>> prRuleC (Cat "A") ("funa", [Cat "A", Cat "B", Cat "B"]) -- /******************** funa ********************/ -- A make_funa(A p1, B p2, B p3) -- { -- A tmp = (A) malloc(sizeof(*tmp)); -- if (!tmp) -- { -- fprintf(stderr, "Error: out of memory when allocating funa!\n"); -- exit(1); -- } -- tmp->kind = is_funa; -- tmp->u.funa_.a_ = p1; -- tmp->u.funa_.b_1 = p2; -- tmp->u.funa_.b_2 = p3; -- return tmp; -- } prRuleC :: Cat -> (String, [Cat]) -> Doc prRuleC _ (fun, _) | isNilFun fun || isOneFun fun = empty prRuleC cat (fun, _) | isConsFun fun = vsep [ "/******************** " <> c <> " ********************/" , c <+> "make_" <> c <> parens (text m <+> "p1" <> "," <+> c <+> "p2") , lbrace , nest 4 $ vsep [ c <+> "tmp = (" <> c <> ") malloc(sizeof(*tmp));" , "if (!tmp)" , lbrace , nest 4 $ vsep [ "fprintf(stderr, \"Error: out of memory when allocating " <> c <> "!\\n\");" , "exit(1);" ] , rbrace , text $ "tmp->" ++ m' ++ " = " ++ "p1;" , "tmp->" <> v <+> "=" <+> "p2;" , "return tmp;" ] , rbrace ] where icat = identCat (normCat cat) c = text icat v = text (map toLower icat ++ "_") ListCat c' = cat -- We're making a list constructor, so we -- expect a list category m = identCat (normCat c') m' = map toLower m ++ "_" prRuleC c (fun, cats) = vsep [ text $ "/******************** " ++ fun ++ " ********************/" , prConstructorC c fun vs cats ] where vs = getVars cats -- | The constructor just assigns the parameters to the corresponding instance -- variables. -- >>> prConstructorC (Cat "A") "funa" [("A",1),("B",2)] [Cat "O", Cat "E"] -- A make_funa(O p1, E p2) -- { -- A tmp = (A) malloc(sizeof(*tmp)); -- if (!tmp) -- { -- fprintf(stderr, "Error: out of memory when allocating funa!\n"); -- exit(1); -- } -- tmp->kind = is_funa; -- tmp->u.funa_.a_ = p1; -- tmp->u.funa_.b_2 = p2; -- return tmp; -- } prConstructorC :: Cat -> String -> [IVar] -> [Cat] -> Doc prConstructorC cat c vs cats = vsep [ text (cat' ++ " make_" ++ c) <> parens args , lbrace , nest 4 $ vsep [ text $ cat' ++ " tmp = (" ++ cat' ++ ") malloc(sizeof(*tmp));" , text "if (!tmp)" , lbrace , nest 4 $ vsep [ text ("fprintf(stderr, \"Error: out of memory when allocating " ++ c ++ "!\\n\");") , text "exit(1);" ] , rbrace , text $ "tmp->kind = is_" ++ c ++ ";" , prAssigns c vs params , text "return tmp;" ] , rbrace ] where cat' = identCat (normCat cat) (types, params) = unzip (prParams cats) args = hsep $ punctuate comma $ zipWith (<+>) types params -- | Prints the constructor's parameters. Returns pairs of type * name -- >>> prParams [Cat "O", Cat "E"] -- [(O,p1),(E,p2)] prParams :: [Cat] -> [(Doc, Doc)] prParams = zipWith prParam [1..] where prParam n c = (text (identCat c), text ("p" ++ show n)) -- | Prints the assignments of parameters to instance variables. -- >>> prAssigns "A" [("A",1),("B",2)] [text "abc", text "def"] -- tmp->u.a_.a_ = abc; -- tmp->u.a_.b_2 = def; prAssigns :: String -> [IVar] -> [Doc] -> Doc prAssigns c vars params = vcat $ zipWith prAssign vars params where prAssign (t,n) p = text ("tmp->u." ++ c' ++ "_." ++ vname t n) <+> char '=' <+> p <> semi vname t n | n == 1 = case findIndices ((== t).fst) vars of [_] -> varName t _ -> varName t ++ showNum n vname t n = varName t ++ showNum n c' = map toLower c {- **** Helper Functions **** -} memName s = map toLower s ++ "_" BNFC-2.8.1/src/BNFC/Backend/C/CFtoCSkel.hs0000644000000000000000000001604512654616013015553 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 BNFC.Backend.C.CFtoCSkel (cf2CSkel) where import BNFC.CF import BNFC.Utils ( (+++) ) import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Utils (isTokenType) import Data.Char ( toLower, toUpper ) import Data.Either (lefts) import Text.PrettyPrint --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 user = "void visit" ++ u' ++ "(" ++ show user ++ " p);" where u' = let u = show user in 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 skeleton's .c File mkCFile :: CF -> [(Cat,[Rule])] -> String mkCFile cf groups = concat [ header, concatMap (prData user) groups, concatMap (prUser.show) 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 ", "#include ", "", "#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) | isList cat = unlines [ "void visit" ++ cl ++ "("++ cl +++ vname ++ ")", "{", " while(" ++ vname ++ " != 0)", " {", " /* Code For " ++ cl ++ " Goes Here */", " visit" ++ ecl ++ "(" ++ vname ++ "->" ++ member ++ "_);", " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", "}", "" ] -- Not a list: | otherwise = unlines [ "void visit" ++ cl ++ "(" ++ cl ++ " _p_)", "{", " switch(_p_->kind)", " {", concatMap (render . 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. -- >>> let ab = Cat "ab" -- >>> prPrintRule [] (Rule "abc" undefined [Left ab, Left ab]) -- case is_abc: -- /* Code for abc Goes Here */ -- visitab(_p_->u.abc_.ab_1); -- visitab(_p_->u.abc_.ab_2); -- break; -- >>> prPrintRule [ab] (Rule "abc" undefined [Left ab]) -- case is_abc: -- /* Code for abc Goes Here */ -- visitAb(_p_->u.abc_.ab_); -- break; -- >>> prPrintRule [ab] (Rule "abc" undefined [Left ab, Left ab]) -- case is_abc: -- /* Code for abc Goes Here */ -- visitAb(_p_->u.abc_.ab_1); -- visitAb(_p_->u.abc_.ab_2); -- break; prPrintRule :: [UserDef] -> Rule -> Doc prPrintRule user (Rule fun _c cats) | not (isCoercion fun) = nest 2 $ vcat [ text $ "case is_" ++ fun ++ ":" , nest 2 (vcat [ "/* Code for " <> text fun <> " Goes Here */" , cats' , "break;" ]) ] where cats' = vcat $ map (prCat user fun) (lefts (numVars cats)) prPrintRule _user (Rule _fun _ _) = "" -- Prints the actual instance-variable visiting. prCat :: [UserDef] -> Fun -> (Cat, Doc) -> Doc prCat user fnm (cat, vname) = let visitf = "visit" <> if isTokenType user cat then basicFunName cat else text (identCat (normCat cat)) in visitf <> parens ("_p_->u." <> text v <> "_." <> vname ) <> ";" where v = map toLower $ normFun fnm --The visit-function name of a basic type basicFunName :: Cat -> Doc basicFunName c = text (toUpper (head (show c)): tail (show c)) BNFC-2.8.1/src/BNFC/Backend/C/CFtoBisonC.hs0000644000000000000000000002236312654616013015727 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 BNFC.Backend.C.CFtoBisonC (cf2Bison, startSymbol) where import BNFC.CF import Data.List (intercalate) import Data.Maybe (fromMaybe) import BNFC.Backend.Common.NamedVariables hiding (varName) import Data.Char (toLower) import BNFC.Utils ((+++)) --This follows the basic structure of CFtoHappy. -- Type declarations type Rules = [(NonTerminal,[(Pattern,Action)])] 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 (allCatsNorm cf), "%token _ERROR_", tokens user env, declarations cf, specialToks cf, startSymbol cf, "%%", prRules (rulesForBison 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);", "int yy_mylinenumber;", "extern int initialize_lexer(FILE * inp);", "void yyerror(const char *str)", "{", " extern char *" ++ name ++ "text;", " fprintf(stderr,\"error: line %d: %s at %s\\n\",", " yy_mylinenumber + 1, str, " ++ name ++ "text);", "}", "", -- M.F. 2004-09-17 changed allEntryPoints to allCatsIdNorm. Seems to fix the [Ty2] bug. unlines $ map parseMethod (allCatsNorm cf), -- (allEntryPoints cf), concatMap reverseList (filter isList (allCatsNorm cf)), "%}" ] --This generates a parser method for each entry point. parseMethod :: Cat -> String parseMethod 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 /= show 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 _ = "" --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 _ _ = "" --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user = concatMap (declTok user) where declTok u (s,r) = if s `elem` map show u then "%token " ++ r ++ " /* " ++ s ++ " */\n" else "%token " ++ r ++ " /* " ++ s ++ " */\n" specialToks :: CF -> String specialToks cf = concat [ ifC catString "%token _STRING_\n", ifC catChar "%token _CHAR_\n", ifC catInteger "%token _INTEGER_\n", ifC catDouble "%token _DOUBLE_\n", ifC catIdent "%token _IDENT_\n" ] where ifC cat s = if isUsedCat cf cat then s else "" startSymbol :: CF -> String startSymbol cf = "%start" +++ identCat (firstEntry cf) --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForBison :: CF -> SymEnv -> Rules rulesForBison 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 (identCat (normCat nt)) (funRule 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 revs = reversibleCats cf eps = allEntryPoints cf isEntry nt = nt `elem` eps result = if isEntry nt then resultName (identCat (normCat nt)) ++ "= $$;" else "" -- | Generates a string containing the semantic action. -- >>> generateAction "Foo" "Bar" False ["$1"] -- "make_Bar($1);" -- >>> generateAction "Foo" "_" False ["$1"] -- "$1;" -- >>> generateAction "ListFoo" "[]" False [] -- "0;" -- >>> generateAction "ListFoo" "(:[])" False ["$1"] -- "make_ListFoo($1, 0);" -- >>> generateAction "ListFoo" "(:)" False ["$1","$2"] -- "make_ListFoo($1, $2);" -- >>> generateAction "ListFoo" "(:)" True ["$1","$2"] -- "make_ListFoo($2, $1);" generateAction :: String -> Fun -> Bool -> [MetaVar] -> Action generateAction nt f b ms | isCoercion f = unwords ms ++ ";" | isNilFun f = "0;" | isOneFun f = concat ["make_", nt, "(", intercalate ", " ms', ", 0);"] | isConsFun f = concat ["make_", nt, "(", intercalate ", " ms', ");"] | otherwise = concat ["make_", f, "(", intercalate ", " 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 -> fromMaybe (typeName (identCat c)) (lookup (show c) env) Right s -> fromMaybe s (lookup s env) 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 ((_, []):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 [unwords [" |", p, "{ $$ =", a , "}"]] ++ pr ls --Some helper functions. resultName :: String -> String resultName s = "YY_RESULT_" ++ s ++ "_" -- | slightly stronger than the NamedVariable version. -- >>> varName (Cat "Abc") -- "abc_" varName :: Cat -> String varName = (++ "_") . map toLower . identCat . normCat typeName :: String -> String typeName "Ident" = "_IDENT_" typeName "String" = "_STRING_" typeName "Char" = "_CHAR_" typeName "Integer" = "_INTEGER_" typeName "Double" = "_DOUBLE_" typeName x = x BNFC-2.8.1/src/BNFC/Backend/C/CFtoCPrinter.hs0000644000000000000000000004077412654616013016306 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 BNFC.Backend.C.CFtoCPrinter (cf2CPrinter) where import BNFC.CF import BNFC.Utils ((+++)) import BNFC.Backend.Common (renderListSepByPrecedence) import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Common.StrUtils (renderCharOrString) import BNFC.Backend.Utils (isTokenType) import Data.List import Data.Char(toLower) import Data.Either (lefts) import BNFC.PrettyPrint --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, _) = 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, _) = 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 ", "", "#define INDENT_WIDTH 2", "", "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) = unlines $ if isList cat then [ "void pp" ++ cl ++ "("++ cl +++ vname ++ ", int i)", "{", " while(" ++ vname ++ "!= 0)", " {", " if (" ++ vname ++ "->" ++ vname ++ "_ == 0)", " {", visitMember, optsep, " " ++ vname +++ "= 0;", " }", " else", " {", visitMember, render (nest 6 (renderListSepByPrecedence "i" renderX (getSeparatorByPrecedence rules))), " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", " }", "}", "" ] --Not a list: else [ "void pp" ++ cl ++ "(" ++ cl ++ " _p_, int _i_)", "{", " switch(_p_->kind)", " {", concatMap (prPrintRule user) rules, " default:", " fprintf(stderr, \"Error: bad kind field when printing " ++ show 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 ++ "_, i);" sep' = getCons rules optsep = if hasOneFunc rules then "" else " " ++ render (renderX sep') ++ ";" -- | Helper function that call the right c function (renderC or renderS) to -- render a literal string. -- -- >>> renderX "," -- renderC(',') -- -- >>> renderX "---" -- renderS("---") renderX :: String -> Doc renderX sep' = "render" <> char sc <> parens (text sep) where (sc, sep) = renderCharOrString sep' --Pretty Printer methods for a rule. prPrintRule :: [UserDef] -> Rule -> String prPrintRule user r@(Rule fun _ 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) (numVars cats) prPrintRule _ _ = "" --This goes on to recurse to the instance variables. prPrintCat :: [UserDef] -> String -> Either (Cat, Doc) String -> String prPrintCat user fnm (c) = case c of Right t -> " " ++ render (renderX t) ++ ";\n" Left (cat, nt) | isTokenType user cat -> " pp" ++ basicFunName (render nt) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ", " ++ show (precCat cat) ++ ");\n" Left (InternalCat, _) -> " /* Internal Category */\n" Left (cat, nt) -> " pp" ++ identCat (normCat cat) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ", " ++ show (precCat cat) ++ ");\n" where v = map toLower (normFun fnm) {- **** 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) = unlines $ if isList cat then [ "void sh" ++ cl ++ "("++ cl +++ vname ++ ")", "{", " while(" ++ vname ++ "!= 0)", " {", " if (" ++ vname ++ "->" ++ vname ++ "_)", " {", visitMember, " bufAppendS(\", \");", " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;", " }", " else", " {", visitMember, " " ++ vname ++ " = 0;", " }", " }", "}", "" ] --Not a list: else [ "void sh" ++ cl ++ "(" ++ cl ++ " _p_)", "{", " switch(_p_->kind)", " {", concatMap (prShowRule user) rules, " default:", " fprintf(stderr, \"Error: bad kind field when showing " ++ show 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 (Rule fun _ 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) (lefts $ numVars cats))) insertSpaces [] = [] insertSpaces (x:[]) = [x] insertSpaces (x:xs) = if x == "" then insertSpaces xs else x : " bufAppendC(' ');\n" : insertSpaces xs allTerms [] = True allTerms (Left _:_) = False allTerms (_:zs) = allTerms zs prShowRule _ _ = "" --This goes on to recurse to the instance variables. prShowCat :: [UserDef] -> Fun -> (Cat, Doc) -> String prShowCat user fnm c = case c of (cat,nt) | isTokenType user cat -> " sh" ++ basicFunName (render nt) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ");\n" (InternalCat, _) -> " /* Internal Category */\n" (cat,nt) | show (normCat $ strToCat$ render nt) /= render nt -> " sh" ++ identCat (normCat cat) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ");\n" (cat,nt) -> concat [ " bufAppendC('[');\n", " sh" ++ identCat (normCat cat) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ");\n", " bufAppendC(']');\n" ] where v = map toLower (normFun fnm) {- **** Helper Functions Section **** -} --The visit-function name of a basic type basicFunName :: String -> String basicFunName v | "integer_" `isPrefixOf` v = "Integer" | "char_" `isPrefixOf` v = "Char" | "string_" `isPrefixOf` v = "String" | "double_" `isPrefixOf` v = "Double" | "ident_" `isPrefixOf` v = "Ident" | otherwise = "Ident" --User-defined type --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_ + INDENT_WIDTH;", " bufAppendC('\\n');", " indent();", " }", " else if (c == '(' || c == '[')", " bufAppendC(c);", " else if (c == ')' || c == ']')", " {", " backup();", " bufAppendC(c);", " }", " else if (c == '}')", " {", " int t;", " _n_ = _n_ - INDENT_WIDTH;", " for(t=0; t 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.8.1/src/BNFC/Backend/Java/0000755000000000000000000000000012654616013014133 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/Java/CFtoJavaAbs15.hs0000644000000000000000000002427412654616013016731 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- 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 BNFC.Backend.Common.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 BNFC.Backend.Java.CFtoJavaAbs15 (cf2JavaAbs, typename) where import BNFC.CF import BNFC.Utils((+++),(++++)) import BNFC.Backend.Common.NamedVariables hiding (IVar, getVars, varName) import Data.Function (on) import Data.List import Data.Char(toLower) import Data.Maybe (mapMaybe) import Text.PrettyPrint --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 _ 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 = getAbstractSyntax 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 ++ mapMaybe (prRule header packageAbsyn funs user cat) rules where funs = map fst rules categoryClass | show 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] -> Cat -> (Fun, [Cat]) -> Maybe (String, String) prRule h packageAbsyn funs user c (fun, cats) | isNilFun fun || isOneFun fun = Nothing --these are not represented in the AbSyn | isConsFun fun =Just (fun', --this is the linked list case. unlines [ h, "public class" +++ fun' +++ "extends java.util.LinkedList<"++ et ++"> {", "}" ]) | otherwise = Just (fun, --a standard rule unlines [ h, "public class" +++ fun ++ ext +++ "{", render $ nest 2 $ vcat [ 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 == show 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 (show $ normCatOfList c) user --The standard accept function for the Visitor pattern prAccept :: String -> Cat -> String -> String prAccept pack cat _ = "\n public R accept(" ++ pack ++ "." ++ show 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 = intercalate " && " $ map checkKid vs checkKid iv = "this." ++ v ++ ".equals(x." ++ v ++ ")" where v = render (iVarName iv) -- Creates the equals() method. prHashCode :: String -> String -> [IVar] -> String prHashCode _ _ vs = unlines $ map (" "++) ["public int hashCode() {", " return " ++ hashKids vs ++ ";", "}" ] where aPrime = 37 hashKids [] = show aPrime hashKids (v:vs) = hashKids_ (hashKid v) vs hashKids_ = foldl (\r v -> show aPrime ++ "*" ++ "(" ++ r ++ ")+" ++ hashKid v) hashKid iv = "this." ++ render (iVarName iv) ++ ".hashCode()" -- | A class's instance variables. -- >>> prInstVars [("A",1,""), ("B",1,""), ("A",2,"abc")] -- public final A _1, abc_2; -- public final B _1; prInstVars :: [IVar] -> Doc prInstVars [] = empty prInstVars vars@((t,_,_):_) = "public" <+> "final" <+> text t <+> uniques <> ";" $$ prInstVars vs' where (uniques, vs') = prUniques t vars --these functions group the types together nicely prUniques :: String -> [IVar] -> (Doc, [IVar]) prUniques t vs = (prVars vs (findIndices (\(y,_,_) -> y == t) vs), remType t vs) prVars vs = hsep . punctuate comma . map (iVarName . (vs!!)) remType :: String -> [IVar] -> [IVar] remType _ [] = [] remType t ((t2,n,nm):ts) | t == t2 = remType t ts | otherwise = (t2,n,nm) : remType t ts -- | Convert IVar to java name -- >>> iVarName ("A",1,"abc") -- abc_1 -- >>> iVarName ("C", 2, "") -- _2 -- >>> iVarName ("Integer", 0, "integer") -- integer_ iVarName :: IVar -> Doc iVarName (_,n,nm) = text (varName nm) <> text (showNum n) -- | The constructor just assigns the parameters to the corresponding instance -- variables. -- >>> prConstructor "bla" [] [("A",1,"a"),("B",1,""),("A",2,"")] [Cat "A",Cat "B", Cat "C"] -- public bla(A p1, B p2, C p3) { a_1 = p1; _ = p2; _2 = p3; } -- >>> prConstructor "EInt" [] [("Integer",0,"integer")] [Cat "Integer"] -- public EInt(Integer p1) { integer_ = p1; } prConstructor :: String -> [UserDef] -> [IVar] -> [Cat] -> Doc prConstructor c u vs cats = "public" <+> text c <> parens (interleave types params) <+> "{" <+> text (prAssigns vs params) <> "}" where (types, params) = unzip (prParams cats u (length cats) (length cats+1)) interleave xs ys = hsep $ punctuate "," $ zipWith ((<+>) `on` text) xs ys --Prints the parameters to the constructors. prParams :: [Cat] -> [UserDef] -> Int -> Int -> [(String,String)] prParams [] _ _ _ = [] prParams (c:cs) u n m = (typename (identCat c) u, 'p' : show (m-n)) : prParams cs u (n-1) m --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,_,_) -> l == t) vs of [] -> varName nm +++ "=" +++ p ++ ";" +++ prAssigns vs ps _ -> varName nm ++ showNum n +++ "=" +++ p ++ ";" +++ prAssigns vs ps else varName nm ++ showNum n +++ "=" +++ p ++ ";" +++ prAssigns vs ps -- Different than the standard BNFC.Backend.Common.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, c):is where c' = typename c user n = maximum (1:[n'+1 | (_,n',c'') <- is, c'' == c]) singleToZero is = [(t,n',nm) | (t,n,nm) <- is, let n' = if length [n | (_,_,n) <- is, n == nm] == 1 then 0 else n] varName :: String -- ^ category name -> String -- ^ Variable name varName c = map toLower c ++ "_" --This makes up for the fact that there's no typedef in Java typename :: String -> [UserDef] -> String typename t user | t == "Ident" = "String" | t == "Char" = "Character" | t `elem` map show user = "String" | otherwise = t BNFC-2.8.1/src/BNFC/Backend/Java/CFtoJavaPrinter15.hs0000644000000000000000000003143412654616013017643 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 BNFC.Backend.Java.CFtoJavaPrinter15 ( cf2JavaPrinter ) where import BNFC.Backend.Java.CFtoJavaAbs15 import BNFC.CF import BNFC.Backend.Common (renderListSepByPrecedence) import BNFC.Backend.Common.NamedVariables import BNFC.Utils ( (+++) ) import Data.List import Data.Char ( toLower, isSpace ) import Data.Either (lefts) import BNFC.PrettyPrint --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;", " private static final int INDENT_WIDTH = 2;", " //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_ + INDENT_WIDTH;", " 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(\"}\"))", " {", " int t;", " _n_ = _n_ - INDENT_WIDTH;", " for(t=0; t 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_)", " {", render $ nest 5 $ 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 (render . prCat (text fnm)) (numVars cats) fnm = '_' : map toLower fun prRule _nm _ = "" -- | -- -- >>> let lfoo = ListCat (Cat "Foo") -- >>> prList [] lfoo [Rule "[]" lfoo [], Rule "(:)" lfoo [Left (Cat "Foo"), Right ".", Left lfoo]] -- for (java.util.Iterator it = foo.iterator(); it.hasNext();) -- { -- pp(it.next(), _i_); -- if (it.hasNext()) { -- render("."); -- } else { -- render("."); -- } -- } prList :: [UserDef] -> Cat -> [Rule] -> Doc prList user c rules = "for (java.util.Iterator<" <> et <> "> it = foo.iterator(); it.hasNext();)" $$ codeblock 2 [ "pp(it.next(), _i_);" , "if (it.hasNext()) {" , nest 2 (renderListSepByPrecedence "_i_" renderSep (getSeparatorByPrecedence rules)) , "} else {" , nest 2 (renderSep optsep <> ";") , "}" ] where et = text (typename (show $ normCatOfList c) user) sep = escapeChars $ getCons rules optsep = if hasOneFunc rules then "" else sep renderSep x = "render(\"" <> text x <>"\")" -- | -- >>> prCat "F" (Right "++") -- render("++"); -- -- >>> prCat "F" (Left (Cat "String", "string_")) -- printQuoted(F.string_); -- -- >>> prCat "F" (Left (InternalCat, "#_")) -- -- >>> prCat "F" (Left (Cat "Abc", "abc_")) -- pp(F.abc_, 0); -- prCat :: Doc -> Either (Cat, Doc) String -> Doc prCat _ (Right t) = nest 7 ("render(\"" <> text(escapeChars t) <> "\");\n") prCat fnm (Left (Cat "String", nt)) = nest 7 ("printQuoted(" <> fnm <> "." <> nt <> ");\n") prCat _ (Left (InternalCat, _)) = empty prCat fnm (Left (cat, nt)) = nest 7 ("pp(" <> fnm <> "." <> nt <> ", " <> integer (precCat cat) <> ");\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 concatMap (render . shCat (text fnm)) (lefts (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 (show $ normCatOfList c) user -- | -- >>> shCat "F" (ListCat (Cat "A"), "lista_") -- render("["); -- sh(F.lista_); -- render("]"); -- -- >>> shCat "F" (InternalCat, "#_") -- -- >>> shCat "F" (Cat "A", "a_") -- sh(F.a_); -- shCat :: Doc -> (Cat, Doc) -> Doc shCat fnm (ListCat _, vname) = vcat [ " render(\"[\");" , " sh(" <> fnm <> "." <> vname <> ");" , " render(\"]\");\n" ] shCat _ (InternalCat, _) = empty shCat fname (_, vname) = " sh(" <> fname <> "." <> vname <> ");\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) BNFC-2.8.1/src/BNFC/Backend/Java/CFtoJLex15.hs0000644000000000000000000001525312654616013016261 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 BNFC.Backend.Java.CFtoJLex15 ( cf2jlex ) where import BNFC.CF import BNFC.Backend.Java.RegToJLex import BNFC.Utils ( (+++) ) import BNFC.Backend.Common.NamedVariables import Text.PrettyPrint --The environment must be returned for the parser to use. cf2jlex :: String -> CF -> Bool -> (Doc, SymEnv) cf2jlex packageBase cf jflex = (vcat [ prelude jflex packageBase, cMacros, lexSymbols jflex env, text $ unlines $ 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) -- | File prelude prelude :: Bool -> String -> Doc prelude jflex packageBase = vcat [ "// This JLex file was machine-generated by the BNF converter" , "package" <+> text packageBase <> ";" , "" , "import java_cup.runtime.*;" , "%%" , "%cup" , "%unicode" , "%line" , "%public" , "%{" , nest 2 $ vcat [ "String pstring = new String();" , "public int line_num() { return (yyline+1); }" , "public String buff()" <+> braces (if jflex then "return new String(zzBuffer,zzCurrentPos,10).trim();" else "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 :: Doc cMacros = vcat [ "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 False [("foo","bar")] -- foo { return new Symbol(sym.bar); } -- >>> lexSymbols False [("\\","bar")] -- \\ { return new Symbol(sym.bar); } -- >>> lexSymbols False [("/","bar")] -- / { return new Symbol(sym.bar); } -- >>> lexSymbols True [("/","bar")] -- \/ { return new Symbol(sym.bar); } -- >>> lexSymbols True [("~","bar")] -- \~ { return new Symbol(sym.bar); } lexSymbols :: Bool -> SymEnv -> Doc lexSymbols jflex ss = vcat $ map transSym ss where transSym (s,r) = "" <> text (escapeChars s) <> " { return new Symbol(sym." <> text r <> "); }" --Helper function that escapes characters in strings escapeChars :: String -> String escapeChars = concatMap (escapeChar jflex) restOfJLex :: CF -> [String] restOfJLex cf = [ lexComments (comments cf), userDefTokens, ifC catString strStates, ifC catChar chStates, ifC catDouble "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? { return new Symbol(sym._DOUBLE_, new Double(yytext())); }", ifC catInteger "{DIGIT}+ { return new Symbol(sym._INTEGER_, new Integer(yytext())); }", ifC catIdent "{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." ++ show 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()); }" BNFC-2.8.1/src/BNFC/Backend/Java/CFtoFoldVisitor.hs0000644000000000000000000000737712654616013017525 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 BNFC.Backend.Java.CFtoFoldVisitor (cf2FoldVisitor) where import BNFC.CF import BNFC.Backend.Java.CFtoJavaAbs15 (typename) import BNFC.Utils ((+++)) import BNFC.Backend.Common.NamedVariables import Data.Either (lefts) import BNFC.PrettyPrint 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 _ (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' = filter ((/= InternalCat) . fst) (lefts (numVars cats)) cls = packageAbsyn ++ "." ++ fun visitVars = lines $ render $ vcat $ map (prCat user) cats' prRule _ _ _ _ = "" -- | Traverses a class's instance variables. -- >>> prCat [Cat "A"] (Cat "A", "a_") -- -- >>> prCat [] (ListCat (Cat "Integer"), "listinteger_") -- -- >>> prCat [] (ListCat (Cat "N"), "listn_") -- for (N x : p.listn_) -- { -- r = combine(x.accept(this, arg), r, arg); -- } -- >>> prCat [] (Cat "N", "n_") -- r = combine(p.n_.accept(this, arg), r, arg); prCat :: [UserDef] -> (Cat, Doc) -- ^ Variable category and name -> Doc -- ^ Code for visiting the variable prCat user (cat,nt) | isBasicType user varType || (isList cat && isBasicType user et) = empty | isList cat = vcat [ "for (" <> text et <> " x : " <> var <> ")" , codeblock 2 [ "r = combine(x.accept(this, arg), r, arg);" ] ] | otherwise = "r = combine(" <> var <> ".accept(this, arg), r, arg);" where var = "p." <> nt varType = typename (identCat (normCat cat)) user et = typename (show$normCatOfList cat) user --Just checks if something is a basic or user-defined type. isBasicType :: [UserDef] -> String -> Bool isBasicType user v = v `elem` (map show user ++ ["Integer","Character","String","Double"]) BNFC-2.8.1/src/BNFC/Backend/Java/CFtoAllVisitor.hs0000644000000000000000000000332512654616013017336 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 BNFC.Backend.Java.CFtoAllVisitor (cf2AllVisitor) where import BNFC.CF import BNFC.Utils ((+++)) import BNFC.Backend.Common.NamedVariables import Data.List cf2AllVisitor :: String -> String -> CF -> String cf2AllVisitor packageBase packageAbsyn cf = unlines [ "package" +++ packageBase ++ ";", "", "import" +++ packageAbsyn ++ ".*;", "", "/** BNFC-Generated All Visitor */", "public interface AllVisitor extends", intercalate ",\n" $ map (" "++) is, "{}"] where groups = [ g | g@(c,_) <- fixCoercions (ruleGroupsInternals cf), not (isList c) ] is = map (prInterface packageAbsyn) groups prInterface :: String -> (Cat, [Rule]) -> String prInterface packageAbsyn (cat, _) = q ++ ".Visitor" where q = packageAbsyn ++ "." ++ identCat cat BNFC-2.8.1/src/BNFC/Backend/Java/CFtoAbstractVisitor.hs0000644000000000000000000000451212654616013020370 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 BNFC.Backend.Java.CFtoAbstractVisitor (cf2AbstractVisitor) where import BNFC.CF import BNFC.Utils ((+++)) import BNFC.Backend.Common.NamedVariables 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 _ _ (Rule fun _ _) | not (isCoercion fun || isDefinedRule fun) = " public R visit(" ++ cls ++ " p, A arg) { return visitDefault(p, arg); }" where cls = packageAbsyn ++ "." ++ fun prRule _ _ _ _ = "" BNFC-2.8.1/src/BNFC/Backend/Java/CFtoVisitSkel15.hs0000644000000000000000000001206312654616013017330 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 BNFC.Backend.Java.CFtoVisitSkel15 (cf2VisitSkel) where import BNFC.CF import BNFC.Backend.Java.CFtoJavaAbs15 (typename) import BNFC.Utils ((+++)) import BNFC.Backend.Common.NamedVariables import Text.PrettyPrint import Data.Either (lefts) --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 (ruleGroupsInternals 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 (render . nest 4 . prRule packageAbsyn user) rules, " }" ] -- | traverses a standard rule. -- >>> prRule "ABSYN" [] (Rule "EInt" undefined [Left (TokenCat "Integer"), Left (Cat "NT")]) -- public R visit(ABSYN.EInt p, A arg) -- { /* Code For EInt Goes Here */ -- //p.integer_; -- p.nt_.accept(new NTVisitor(), arg); -- return null; -- } -- -- It skips the internal category (indicating that a rule is not parsable) -- >>> prRule "ABSYN" [] (Rule "EInt" undefined [Left (InternalCat), Left (TokenCat "Integer")]) -- public R visit(ABSYN.EInt p, A arg) -- { /* Code For EInt Goes Here */ -- //p.integer_; -- return null; -- } prRule :: String -> [UserDef] -> Rule -> Doc prRule packageAbsyn user (Rule fun _ cats) | not (isCoercion fun || isDefinedRule fun) = vcat [ "public R visit(" <> text packageAbsyn <> "." <> fname <> " p, A arg)" , "{" , nest 2 ( "/* Code For " <> fname <> " Goes Here */" $$ vcat (map (prCat user) cats') $$ "return null;" ) , "}" ] where fname = text fun -- function name cats' = filter ((/= InternalCat).fst) (lefts (numVars cats)) -- non-terminals in the rhs prRule _ _ _ = "" -- | Traverses a class's instance variables. -- >>> prCat [] (Cat "A", "a_") -- p.a_.accept(new AVisitor(), arg); -- >>> prCat [] (TokenCat "Integer", "integer_") -- //p.integer_; -- >>> prCat [Cat "A"] (TokenCat "A", "a_") -- //p.a_; -- >>> prCat [Cat "A"] (TokenCat "A", "a_2") -- //p.a_2; -- >>> prCat [] (ListCat (Cat "A"), "lista_") -- for (A x: p.lista_) -- { /* ... */ } prCat :: [UserDef] -- ^ User defined tokens -> (Cat, Doc) -- ^ Variable category and name -> Doc -- ^ Code for visiting the variable prCat user (cat, nt) | isTokenCat cat = "//" <> var <> ";" | isList cat = "for" <+> parens (text et <+> "x:" <+> var) $$ braces " /* ... */ " | otherwise = accept where var = "p." <> nt varType = typename (identCat (normCat cat)) user accept = var <> ".accept(new " <> text varType <> "Visitor(), arg);" et = typename (show $normCatOfList cat) user BNFC-2.8.1/src/BNFC/Backend/Java/CFtoCup15.hs0000644000000000000000000002500312654616013016140 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 BNFC.Backend.Java.CFtoCup15 ( cf2Cup ) where import BNFC.CF import Data.List import BNFC.Backend.Common.NamedVariables import BNFC.Utils ( (+++) ) import BNFC.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 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) = show$normCat$strToCat 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 ++ "_ (" ++ intercalate ", " (map javaArg args) ++ ") {" , " return " ++ javaExp e' ++ ";" , "}" ] where javaType :: Base -> String javaType (ListT (BaseT x)) = packageAbsyn ++ ".List" ++ show (normCat$strToCat x) javaType (ListT t) = javaType t javaType (BaseT x) | isToken x ctx = "String" | otherwise = packageAbsyn ++ "." ++ show (normCat$strToCat x) javaArg :: (String, Base) -> String javaArg (x,t) = javaType t ++ " " ++ x ++ "_" javaExp :: Exp -> String javaExp (App "null" []) = "null" javaExp (App x []) | x `elem` 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 ++ "(" ++ intercalate ", " (map javaExp es) ++ ")" -- peteg: FIXME JavaCUP can only cope with one entry point AFAIK. prEntryPoint :: CF -> String prEntryPoint cf = unlines ["", "start with " ++ show (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 -> [Cat] -> 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 catString "terminal String _STRING_;", ifC catChar "terminal Character _CHAR_;", ifC catInteger "terminal Integer _INTEGER_;", ifC catDouble "terminal Double _DOUBLE_;", ifC catIdent "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 <- tokenNames 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 env r]) where revM False = id revM True = reverse 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 ++ "_" ++ "(" ++ intercalate "," ms ++ ");" | otherwise = "RESULT = new " ++ c ++ "(" ++ intercalate "," 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 [] (Rule "myfun" (Cat "A") []) -- (" /* empty */ ",[]) -- >>> generatePatterns [("def", "_SYMB_1")] (Rule "myfun" (Cat "A") [Right "def", Left (Cat "B")]) -- ("_SYMB_1 B:p_2 ",["p_2"]) generatePatterns :: SymEnv -> Rule -> (Pattern,[MetaVar]) generatePatterns env r = case rhsRule r of [] -> (" /* empty */ ",[]) its -> (mkIt 1 its, metas its) where mkIt _ [] = [] mkIt n (i:is) = case i of Left c -> c' ++ ":p_" ++ show (n :: Int) +++ mkIt (n+1) is where c' = case c of TokenCat "Ident" -> "_IDENT_" TokenCat "Integer" -> "_INTEGER_" TokenCat "Char" -> "_CHAR_" TokenCat "Double" -> "_DOUBLE_" TokenCat "String" -> "_STRING_" _ -> identCat c Right s -> case lookup s env of (Just x) -> x +++ mkIt (n+1) is (Nothing) -> mkIt n is metas its = ["p_" ++ show i | (i,Left _) <- 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 ((_, []):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 [unwords [" |", p, "{:", a , ":}"]] ++ pr ls BNFC-2.8.1/src/BNFC/Backend/Java/RegToJLex.hs0000644000000000000000000000570312654616013016277 0ustar0000000000000000module BNFC.Backend.Java.RegToJLex (printRegJLex, escapeChar) where -- modified from pretty-printer generated by the BNF converter import AbsBNF -- 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 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 False c] prtList s = map (concat . prt 0) s escapeChar :: Bool -> Char -> String escapeChar _ '^' = "\\x5E" -- special case, since \^ is a control character escape escapeChar False x | x `elem` jlexReserved = '\\' : [x] escapeChar True x | x `elem` jflexReserved = '\\' : [x] escapeChar _ x = [x] -- Characters that must be escaped in JLex regular expressions jlexReserved :: [Char] jlexReserved = ['?','*','+','|','(',')','^','$','.','[',']','{','}','"','\\'] jflexReserved :: [Char] jflexReserved = '~':'!':'/':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 _ _ -> 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.8.1/src/BNFC/Backend/Java/CFtoComposVisitor.hs0000644000000000000000000001067312654616013020072 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 BNFC.Backend.Java.CFtoComposVisitor (cf2ComposVisitor) where import BNFC.CF import BNFC.Backend.Java.CFtoJavaAbs15 (typename) import BNFC.Utils ((+++)) import BNFC.Backend.Common.NamedVariables import Data.List import Data.Either (lefts) import BNFC.PrettyPrint 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, _) = q ++ ".Visitor<" ++ q ++ ",A>" where q = packageAbsyn ++ "." ++ identCat cat --Traverses a category based on its type. prData :: String -> [UserDef] -> (Cat, [Rule]) -> String prData packageAbsyn user (cat, rules) = unlines [ "/* " ++ identCat cat ++ " */", concatMap (render . prRule packageAbsyn user cat) rules ] -- | traverses a standard rule. -- >>> prRule "lang.absyn" [Cat "A"] (Cat "B") (Rule "F" (Cat "B") [Left (Cat "A"), Right "+", Left (ListCat (Cat "B"))]) -- public B visit(lang.absyn.F p, A arg) -- { -- String a_ = p.a_; -- ListB listb_ = new ListB(); -- for (B x : p.listb_) -- { -- listb_.add(x.accept(this,arg)); -- } -- return new lang.absyn.F(a_, listb_); -- } prRule :: String -> [UserDef] -> Cat -> Rule -> Doc prRule packageAbsyn user cat (Rule fun _ cats) | not (isCoercion fun || isDefinedRule fun) = nest 4 $ vcat [ "public " <> text(identCat cat) <> " visit(" <> cls <> " p, A arg)" , codeblock 2 [ vcat (map (prCat user) cats') , "return new" <+> cls <> parens (hsep (punctuate "," vnames)) <> ";" ] ] where cats' = filter ((/= InternalCat) . fst) (lefts (numVars cats)) cls = text (packageAbsyn ++ "." ++ fun) vnames = map snd cats' prRule _ _ _ _ = "" -- | Traverses a class's instance variables. -- >>> prCat [Cat "A"] (Cat "A", "a_") -- String a_ = p.a_; -- >>> prCat [] (ListCat (Cat "Integer"), "listinteger_") -- ListInteger listinteger_ = p.listinteger_; -- >>> prCat [] (ListCat (Cat "N"), "listn_") -- ListN listn_ = new ListN(); -- for (N x : p.listn_) -- { -- listn_.add(x.accept(this,arg)); -- } -- >>> prCat [] (Cat "N", "n_") -- N n_ = p.n_.accept(this, arg); prCat :: [UserDef] -- ^ User defined token categories -> (Cat, Doc) -- ^ Variable category and names -> Doc -- ^ Code for visiting the variable prCat user (cat, nt) | isBasicType user varType || (isList cat && isBasicType user et) = decl var | isList cat = decl ("new" <+> text varType <> "()") $$ "for (" <> text et <> " x : " <> var <> ")" $$ codeblock 2 [ nt <> ".add(x.accept(this,arg));" ] | otherwise = decl (var <> ".accept(this, arg)") where var = "p." <> nt varType = typename (identCat (normCat cat)) user et = typename (show$normCatOfList cat) user decl v = text varType <+> nt <+> "=" <+> v <> ";" --Just checks if something is a basic or user-defined type. isBasicType :: [UserDef] -> String -> Bool isBasicType user v = v `elem` (map show user ++ ["Integer","Character","String","Double"]) BNFC-2.8.1/src/BNFC/Backend/Common/0000755000000000000000000000000012654616013014502 5ustar0000000000000000BNFC-2.8.1/src/BNFC/Backend/Common/StrUtils.hs0000644000000000000000000000221012654616013016622 0ustar0000000000000000module BNFC.Backend.Common.StrUtils where -- | Function that, given an input string, renders it either as a char (if -- it has legth 1) or a string. It should also excape characters correctly. -- The first returned value is the 'type' of the string: either C for char -- or S for string. (used in the C printer to choose the right rendering -- function) -- e.g. -- >>> renderCharOrString "a" -- ('C',"'a'") -- >>> renderCharOrString "abc" -- ('S',"\"abc\"") -- >>> renderCharOrString "'" -- ('C',"'\\''") -- >>> renderCharOrString "\"\\'" -- ('S',"\"\\\"\\\\\\'\"") renderCharOrString :: String -> (Char, String) renderCharOrString [char] = ('C', show char) -- using show shoud quote ' renderCharOrString s =('S', "\"" ++ escapeChars s ++ "\"") -- | Helper function that escapes characters in strings -- >>> escapeChars "\\" -- "\\\\" -- >>> escapeChars "\"" -- "\\\"" -- >>> escapeChars "'" -- "\\'" escapeChars :: String -> String escapeChars [] = [] escapeChars ('\\':xs) = '\\' : '\\' : escapeChars xs escapeChars ('\"':xs) = '\\' : '\"' : escapeChars xs escapeChars ('\'':xs) = '\\' : '\'' : escapeChars xs escapeChars (x:xs) = x : escapeChars xs BNFC-2.8.1/src/BNFC/Backend/Common/OOAbstract.hs0000644000000000000000000001076212654616013017045 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 BNFC.Backend.Common.OOAbstract where import BNFC.CF import Data.List import Data.Char(toLower) -- A datastructure more appropriate than CF data CAbs = CAbs { tokentypes :: [String], -- user non-position token types listtypes :: [(String,Bool)], -- list types used, whether of classes absclasses :: [String], -- grammar-def cats, normalized names conclasses :: [Fun], -- constructors, except list ones signatures :: [(String,[CAbsRule])], -- rules for each class, incl. pos tokens postokens :: [String], -- position token types defineds :: [Fun] -- defined (non-)constructors } -- (valcat,(constr,args)), True = is class (not basic), class variable stored type CAbsRule = (Fun,[(String,Bool,String)]) -- all those names that denote classes in C++ allClasses :: CAbs -> [String] allClasses ca = absclasses ca ++ conclasses ca ++ map fst (listtypes ca) ++ postokens ca -- all those names that denote non-class types in C++ allNonClasses :: CAbs -> [String] 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 (identCat . normCat) lists], absclasses = nub $ map (show.normCat) cats, conclasses = [f | Just f <- map testRule (rulesOfCF cf)], signatures = posdata ++ map normSig (cf2data cf), postokens = map show pos, defineds = defs } where (pos,base) = partition (isPositionCat cf) $ fst (unzip (tokenPragmas cf)) (lists,cats) = partition isList $ allCatsNorm cf toks = map (show.normCat) base testRule (Rule f c _) | 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 [(show 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 :: [(String,Bool)] -> [(String,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 -> String -> Bool isBaseType cf c = elem c $ tokentypes cf ++ map fst basetypes classVar :: String -> String classVar c = map toLower c ++ "_" pointerIf :: Bool -> String -> String pointerIf b v = if b then "*" ++ v else v BNFC-2.8.1/src/BNFC/Backend/Common/Makefile.hs0000644000000000000000000000137412654616013016560 0ustar0000000000000000module BNFC.Backend.Common.Makefile where import Text.Printf import BNFC.Options (SharedOptions(..)) import BNFC.Backend.Base (mkfile, Backend) type Makefile = ShowS mkRule :: String -- ^ The target name -> [String] -- ^ Dependencies -> [String] -- ^ Recipe -> Makefile mkRule target deps recipe = (++) $ unlines $ [ unwords (printf "%s:" target:deps) ] ++ map (printf "\t%s") recipe ++ [""] mkVar :: String -> String -> Makefile mkVar n v = (++) (n ++ "=" ++ v ++ "\n") -- | Create the Makefile file using the name specified in the option -- record. mkMakefile :: SharedOptions -> String -> Backend mkMakefile Options {make = Nothing} _ = return () mkMakefile Options {make = Just makefile} content = mkfile makefile content BNFC-2.8.1/src/BNFC/Backend/Common/NamedVariables.hs0000644000000000000000000001272212654616013017717 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) ************************************************************** The idea of this module is the following (if I got it correctly): In some target languages (e.g. java or C) you need to create a variable name for each non terminal in a given rule. For instance, the following rules: > SomeFunction. A ::= B C D ; could be represented in C by a structure like: @ struct A { B b_; C c_; D d_; } @ (note that this is not exactly the representation produced by bnfc) but if there is several non terminal of the same category, we need to number them. Eg: > SomeFunction. A = B B ; Should become something like: @ struct A { B b_1, b_2; } @ This is what this module does. -} module BNFC.Backend.Common.NamedVariables where import BNFC.CF import Data.Char (toLower) import Data.List (nub) import Text.PrettyPrint import Control.Arrow (left, (&&&)) import Data.Either (lefts) type IVar = (String, Int) --The type of an instance variable --and a # unique to that type type UserDef = Cat --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. If a category appears only once, it is given the number 0, -- if it appears more than once, its occurrences are numbered from 1. ex: -- -- >>> getVars [Cat "A", Cat "B", Cat "A"] -- [("A",1),("B",0),("A",2)] -- 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) -- # Create variable names for rules rhs -- This is about creating variable names for the right-hand side of rules. -- In particular, if you have a rule like Foo. Bar ::= A B A, you need to -- create unique variable names for the two instances of category A -- | Anotate the right hand side of a rule with variable names -- for the non-terminals. -- >>> numVars [Left (Cat "A"), Right "+", Left (Cat "B")] -- [Left (A,a_),Right "+",Left (B,b_)] -- >>> numVars [Left (Cat "A"), Left (Cat "A"), Right ";"] -- [Left (A,a_1),Left (A,a_2),Right ";"] numVars :: [Either Cat a] -> [Either (Cat, Doc) a] numVars cats = -- First, we anotate each Left _ with a variable name (not univque) let withNames = map (left (id &&& (varName . identCat . normCat))) cats -- next, the function f' adds numbers where needed... in f' [] withNames where f' _ [] = [] f' env (Right t:xs) = Right t:f' env xs f' env (Left (c,n):xs) = -- we should use n_i as var name let i = maybe 1 (+1) (lookup n env) -- Is there more use of the name u_ ? thereIsMore = n `elem` map snd (lefts xs) vname = text n <> if i > 1 || thereIsMore then int i else empty in Left (c, vname) : f' ((n,i):env) xs --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 :: Eq b => [Either String b] -> [Either String b] 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,_):cats) = if isCoercion (show cat) -- This is weird: isCoercion is supposed to be applied to functions!!!! 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.8.1/dist/0000755000000000000000000000000012654616013011367 5ustar0000000000000000BNFC-2.8.1/dist/build/0000755000000000000000000000000012654616013012466 5ustar0000000000000000BNFC-2.8.1/dist/build/bnfc/0000755000000000000000000000000012654616013013376 5ustar0000000000000000BNFC-2.8.1/dist/build/bnfc/bnfc-tmp/0000755000000000000000000000000012654616013015104 5ustar0000000000000000BNFC-2.8.1/dist/build/bnfc/bnfc-tmp/LexBNF.hs0000644000000000000000000015033212654616013016522 0ustar0000000000000000{-# LANGUAGE CPP,MagicHash #-} {-# LINE 3 "src/LexBNF.x" #-} {-# OPTIONS -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -w #-} module LexBNF where import qualified Data.Bits import Data.Word (Word8) import Data.Char (ord) #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\xc9\xff\xff\xff\xe0\xff\xff\xff\xc9\x00\x00\x00\x9c\x01\x00\x00\x2d\x00\x00\x00\x1c\x02\x00\x00\x1c\x03\x00\x00\x0a\x01\x00\x00\x00\x00\x00\x00\x0d\x03\x00\x00\x0d\x04\x00\x00\xcd\x03\x00\x00\xcd\x04\x00\x00\x91\x05\x00\x00\xef\x05\x00\x00\x8d\x04\x00\x00\x00\x00\x00\x00\xa5\x05\x00\x00\xdb\xff\xff\xff\x47\x00\x00\x00\x5a\x00\x00\x00\xa5\x06\x00\x00\xa6\x06\x00\x00\x69\x07\x00\x00\x29\x07\x00\x00\x00\x00\x00\x00\x1f\x08\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\xf8\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x00\x00\x00\xe7\x05\x00\x00\x7c\x00\x00\x00"# alex_table :: AlexAddr alex_table = AlexA# "\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x21\x00\x25\x00\x16\x00\x1c\x00\x05\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x02\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x1f\x00\x21\x00\x00\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x22\x00\x21\x00\x00\x00\x21\x00\x00\x00\x21\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x21\x00\x03\x00\x21\x00\x00\x00\x21\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x20\x00\x21\x00\x21\x00\x01\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x03\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x03\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\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\x08\x00\x09\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\x19\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\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\x08\x00\x09\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\x04\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x06\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\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\x0c\x00\x0d\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\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x1a\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\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x24\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x10\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x0f\x00\x11\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\x19\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1a\x00\x04\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x13\x00\x07\x00\x0a\x00\x0a\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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\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\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\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\x05\x00\xff\xff\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\x05\x00\x05\x00\x12\x00\x12\x00\x03\x00\x03\x00\xff\xff\x17\x00\xff\xff\x17\x00\x1b\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1c\x00\x1c\x00\x1c\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,40) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,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 39 "src/LexBNF.x" #-} tok :: (Posn -> String -> Token) -> (Posn -> String -> Token) 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 :: [Token] -> String tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l tokenPos (Err (Pn _ l _) :_) = "line " ++ show l tokenPos _ = "end of file" tokenPosn :: Token -> Posn tokenPosn (PT p _) = p tokenPosn (Err p) = p tokenLineCol :: Token -> (Int, Int) tokenLineCol = posLineCol . tokenPosn posLineCol :: Posn -> (Int, Int) posLineCol (Pn _ l c) = (l,c) mkPosToken :: Token -> ((Int, Int), String) mkPosToken t@(PT p _) = (posLineCol p, prToken t) prToken :: Token -> String 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 Err _ -> "#Error" 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 :: BTree 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 "" #-} {-# LINE 9 "" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4 # 17 "/usr/include/stdc-predef.h" 3 4 {-# LINE 9 "" #-} {-# 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 21 "templates/GenericTemplate.hs" #-} -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) #else #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif {-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #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) -> case fromIntegral c of { (I# (ord_c)) -> let base = alexIndexInt32OffAddr alex_base s offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset new_s = if GTE(offset,0#) && EQ(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 (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) {-# LINE 198 "templates/GenericTemplate.hs" #-} 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 = AlexAccNone | AlexAcc a | AlexAccSkip {-# LINE 242 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i BNFC-2.8.1/dist/build/bnfc/bnfc-tmp/ParBNF.hs0000644000000000000000000020027012654616013016511 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 import Control.Applicative(Applicative(..)) import Control.Monad (ap) -- parser produced by Happy Version 1.19.5 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# "\x45\x00\x45\x00\x45\x00\x64\x00\x64\x00\x00\x00\x64\x00\xbc\x00\xbd\x00\x71\x00\x71\x00\xda\x01\xd9\x01\xd8\x01\xd6\x01\xd7\x01\x7e\x01\xd5\x01\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\xd4\x01\x00\x00\x00\x00\xd3\x01\x29\x00\x29\x00\x29\x00\x29\x00\xd2\x01\xcc\x01\x00\x00\xd1\x01\xcb\x01\x00\x00\x00\x00\x11\x00\xd0\x01\x89\x01\xc8\x01\x29\x00\xc9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x01\x00\x00\x3e\x00\xe2\xff\x01\x00\xc5\x01\x00\x00\xbc\x00\xc5\x01\xc5\x01\xc4\x01\xcf\x01\xc3\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\xce\x01\xca\x01\x00\x00\xc2\x01\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x07\x00\xc2\x01\xc2\x01\xc2\x01\xc2\x01\x6a\x01\x00\x00\xc2\x01\xc2\x01\xc1\x01\xc1\x01\xcd\x01\xbf\x01\xc0\x01\xc7\x01\xbe\x01\xbc\x01\xc6\x01\xba\x01\xba\x01\xba\x01\x00\x00\xba\x01\xbd\x01\xb9\x01\x00\x00\xb4\x01\x5e\x00\x00\x00\xb4\x01\xbd\x00\x00\x00\xb4\x01\x00\x00\xb4\x01\xbb\x01\xb6\x01\xb5\x01\xb3\x01\xbd\x00\xb3\x01\x44\x00\x68\x01\xaf\x01\xad\x01\xa8\x01\xa8\x01\xa6\x01\x7c\x00\x9c\x01\xb7\x01\x9b\x01\x00\x00\x8b\x00\xb0\x01\x9a\x01\x00\x00\xb8\x01\x99\x01\x98\x01\x98\x01\x00\x00\x00\x00\x64\x00\x45\x00\x93\x01\x64\x00\x00\x00\x29\x00\xbd\x00\xbd\x00\xb2\x01\x8e\x01\x00\x00\x96\x01\x00\x00\xae\x01\x00\x00\x95\x01\x00\x00\x95\x01\x91\x01\xbd\x00\xab\x01\xb1\x01\x00\x00\xfe\xff\x00\x00\x6e\x00\x84\x01\xa9\x01\xa7\x01\xa7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x01\xac\x01\x07\x00\x07\x00\x00\x00\x8d\x01\x00\x00\x10\x01\x29\x00\x00\x00\x00\x00\x00\x00\x85\x01\xa3\x01\xaa\x01\x29\x00\x29\x00\x00\x00\x00\x00\x00\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x01\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x01\x00\x00\x00\x00\xa1\x01\x00\x00\x00\x00\xf6\xff\x80\x01\xbd\x00\x00\x00\x29\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\x9e\x01\x7e\x01\x07\x00\x00\x00\xa4\x01\xa0\x01\x97\x01\x00\x00\xbc\x00\x00\x00\x8c\x01\x00\x00\xbc\x00\x00\x00\x78\x01\x94\x01\x9f\x01\x00\x00\x00\x00"# happyGotoOffsets :: HappyAddr happyGotoOffsets = HappyA# "\x86\x00\xa3\x00\xa1\x00\x58\x01\x6e\x01\x90\x01\x70\x01\x82\x01\x86\x01\x77\x01\x06\x00\x87\x01\x8f\x01\xb2\x00\x8b\x01\x48\x01\x74\x01\x0c\x00\x7f\x01\x30\x01\x4b\x01\x50\x01\x05\x01\xf6\x00\xc7\x00\x3c\x01\x31\x00\x3e\x01\xc0\x00\xb0\x00\x46\x00\xaa\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x92\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x01\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x01\xd9\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x7a\x01\x6b\x01\x28\x01\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x01\x00\x00\x00\x00\x83\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x01\x5d\x01\x56\x01\x61\x01\x22\x00\x72\x01\xc5\x00\x00\x00\x46\x01\x1d\x01\xfe\x00\x0b\x01\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x01\x91\x00\x04\x00\x67\x01\x00\x00\x9a\x00\x35\x01\x0a\x01\x00\x00\xee\x00\x00\x00\x79\x00\x00\x00\x00\x00\x00\x00\xe9\x00\xfc\xff\xe0\x00\xce\x00\xe7\x00\x00\x00\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x88\x01\x24\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x01\xd4\x00\x00\x00\x4b\x00\x37\x01\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\xcf\x00\x02\x00\x00\x00\x96\x00\x42\x00\xb5\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x00\x21\x01\x94\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\x00\x00\x00\xec\xff\x13\x00\xde\x00\x00\x00\x72\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\x0b\x00\x01\x00\x01\x00\x01\x00\x01\x00\x08\x00\x01\x00\x01\x00\x27\x00\x01\x00\x0d\x00\x20\x00\x01\x00\x0d\x00\x0d\x00\x2e\x00\x10\x00\x01\x00\x17\x00\x0d\x00\x0f\x00\x15\x00\x06\x00\x17\x00\x16\x00\x03\x00\x1a\x00\x1b\x00\x0a\x00\x0d\x00\x03\x00\x2a\x00\x10\x00\x16\x00\x01\x00\x01\x00\x24\x00\x15\x00\x26\x00\x17\x00\x25\x00\x01\x00\x1a\x00\x1b\x00\x2c\x00\x25\x00\x2e\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x24\x00\x0d\x00\x26\x00\x21\x00\x10\x00\x23\x00\x0a\x00\x03\x00\x2c\x00\x15\x00\x23\x00\x17\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x01\x00\x01\x00\x25\x00\x25\x00\x03\x00\x0c\x00\x00\x00\x0a\x00\x24\x00\x00\x00\x26\x00\x1f\x00\x0d\x00\x0d\x00\x0f\x00\x0f\x00\x2c\x00\x11\x00\x12\x00\x13\x00\x14\x00\x21\x00\x16\x00\x23\x00\x18\x00\x19\x00\x01\x00\x1e\x00\x1f\x00\x1d\x00\x1e\x00\x1f\x00\x01\x00\x21\x00\x22\x00\x1d\x00\x23\x00\x25\x00\x0d\x00\x2e\x00\x0f\x00\x2a\x00\x2a\x00\x02\x00\x0d\x00\x01\x00\x0f\x00\x02\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x16\x00\x0d\x00\x18\x00\x19\x00\x0d\x00\x02\x00\x0f\x00\x1d\x00\x1e\x00\x1f\x00\x12\x00\x21\x00\x22\x00\x01\x00\x2a\x00\x0d\x00\x02\x00\x05\x00\x06\x00\x07\x00\x2a\x00\x12\x00\x05\x00\x0b\x00\x01\x00\x08\x00\x0e\x00\x0f\x00\x1d\x00\x06\x00\x07\x00\x03\x00\x12\x00\x2a\x00\x0b\x00\x03\x00\x0a\x00\x0e\x00\x0f\x00\x03\x00\x01\x00\x15\x00\x01\x00\x29\x00\x2a\x00\x06\x00\x07\x00\x06\x00\x2e\x00\x25\x00\x0b\x00\x03\x00\x0b\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x03\x00\x02\x00\x00\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\x03\x00\x12\x00\x00\x00\x25\x00\x00\x00\x25\x00\x0d\x00\x0d\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x02\x00\x21\x00\x22\x00\x23\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\x00\x00\x21\x00\x1d\x00\x23\x00\x1d\x00\x29\x00\x2a\x00\x2a\x00\x01\x00\x00\x00\x0c\x00\x0d\x00\x18\x00\x19\x00\x1a\x00\x01\x00\x1c\x00\x18\x00\x19\x00\x1a\x00\x0d\x00\x1c\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\x01\x00\x01\x00\x10\x00\x18\x00\x19\x00\x1a\x00\x14\x00\x1c\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x0d\x00\x0f\x00\x10\x00\x1a\x00\x1b\x00\x0c\x00\x14\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\x11\x00\x01\x00\x13\x00\x10\x00\x18\x00\x19\x00\x1a\x00\x14\x00\x20\x00\x18\x00\x19\x00\x1a\x00\x0a\x00\x0d\x00\x18\x00\x19\x00\x1a\x00\x0a\x00\x01\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\x1e\x00\x1f\x00\x01\x00\x10\x00\x01\x00\x1e\x00\x1f\x00\x14\x00\x00\x00\x20\x00\x01\x00\x08\x00\x09\x00\x01\x00\x0b\x00\x19\x00\x1a\x00\x0e\x00\x0f\x00\x01\x00\x0b\x00\x1a\x00\x00\x00\x0e\x00\x0f\x00\x0d\x00\x01\x00\x09\x00\x01\x00\x0b\x00\x01\x00\x01\x00\x0e\x00\x0f\x00\x09\x00\x01\x00\x0b\x00\x00\x00\x0b\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x00\x00\x01\x00\x01\x00\x0e\x00\x0f\x00\x01\x00\x20\x00\x15\x00\x00\x00\x23\x00\x03\x00\x04\x00\x0c\x00\x0d\x00\x0d\x00\x29\x00\x00\x00\x0d\x00\x2a\x00\x0c\x00\x17\x00\x10\x00\x2e\x00\x11\x00\x0a\x00\x13\x00\x11\x00\x1f\x00\x13\x00\x21\x00\x11\x00\x02\x00\x0e\x00\x2b\x00\x0d\x00\x05\x00\x02\x00\x09\x00\x1c\x00\x29\x00\x09\x00\x0e\x00\x02\x00\x28\x00\x02\x00\x2b\x00\x0e\x00\x0e\x00\x01\x00\x0e\x00\x0d\x00\x07\x00\x29\x00\x0e\x00\x2a\x00\x0e\x00\x0a\x00\x09\x00\x2b\x00\x2a\x00\x29\x00\x29\x00\x08\x00\x0a\x00\x07\x00\x2a\x00\x1c\x00\x08\x00\x2e\x00\x0e\x00\x2e\x00\x2e\x00\x2e\x00\x05\x00\x05\x00\x0d\x00\x01\x00\xff\xff\x2a\x00\x22\x00\x08\x00\x05\x00\x05\x00\xff\xff\x05\x00\x2a\x00\x01\x00\xff\xff\xff\xff\x01\x00\xff\xff\x2a\x00\x29\x00\xff\xff\x2a\x00\xff\xff\x2e\x00\x0d\x00\xff\xff\xff\xff\x0d\x00\x2b\x00\x2e\x00\xff\xff\x29\x00\x27\x00\x2e\x00\x2e\x00\xff\xff\x1c\x00\x2e\x00\x2e\x00\x29\x00\x2e\x00\xff\xff\x29\x00\x2e\x00\x27\x00\xff\xff\x2e\x00\xff\xff\xff\xff\x2a\x00\x29\x00\xff\xff\x2a\x00\xff\xff\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\xff\xff"# happyTable :: HappyAddr happyTable = HappyA# "\x00\x00\xea\x00\x2c\x00\x6a\x00\x54\x00\x23\x00\xa7\x00\x63\x00\x4a\x00\xb9\x00\x23\x00\xab\x00\xf4\x00\x54\x00\x2d\x00\xe7\x00\xff\xff\x2e\x00\x2c\x00\xd6\x00\x4b\x00\x64\x00\x2f\x00\xc0\x00\x30\x00\xae\x00\x26\x00\x31\x00\x32\x00\xf3\x00\x2d\x00\x26\x00\x26\x00\x2e\x00\x55\x00\x23\x00\x23\x00\x33\x00\x2f\x00\x34\x00\x30\x00\xe0\x00\x2c\x00\x31\x00\x32\x00\x35\x00\x8c\x00\xff\xff\x23\x00\x26\x00\x4c\x00\x35\x00\x4d\x00\x33\x00\x2d\x00\x34\x00\xc0\x00\x2e\x00\x29\x00\x3a\x00\x26\x00\x35\x00\x2f\x00\xb7\x00\x30\x00\xba\x00\xbb\x00\x31\x00\x32\x00\x66\x00\x66\x00\x9b\x00\x24\x00\x26\x00\xbc\x00\x3e\x00\x3a\x00\x33\x00\xe3\x00\x34\x00\x3b\x00\x67\x00\x67\x00\x68\x00\x68\x00\x35\x00\x73\x00\x74\x00\x75\x00\x76\x00\xc4\x00\x77\x00\x29\x00\x78\x00\x79\x00\xa5\x00\xe5\x00\x3d\x00\x7a\x00\x7b\x00\x7c\x00\x66\x00\x7d\x00\x7e\x00\xc6\x00\x35\x00\x89\x00\x67\x00\xff\xff\x68\x00\x26\x00\x26\x00\xd0\x00\x67\x00\x66\x00\x68\x00\x5f\x00\x73\x00\x74\x00\x75\x00\x76\x00\x3e\x00\x77\x00\xd1\x00\x78\x00\x79\x00\x67\x00\x5f\x00\x68\x00\x7a\x00\x7b\x00\x7c\x00\xf6\x00\x7d\x00\x7e\x00\x83\x00\x26\x00\x6d\x00\x5f\x00\x8a\x00\x84\x00\x8b\x00\x26\x00\xce\x00\x90\x00\x86\x00\x83\x00\x75\xff\x71\x00\x69\x00\xd9\x00\x84\x00\xe1\x00\x26\x00\xa8\x00\x26\x00\x86\x00\x26\x00\xef\x00\x71\x00\x69\x00\x26\x00\x83\x00\xf1\x00\x83\x00\x23\x00\x26\x00\x84\x00\x85\x00\x89\x00\xff\xff\x87\x00\x86\x00\x26\x00\x86\x00\x71\x00\x69\x00\x71\x00\x69\x00\x26\x00\x5f\x00\xe4\x00\x87\x00\x27\x00\x28\x00\x29\x00\xe6\x00\x27\x00\x28\x00\x29\x00\xde\x00\x27\x00\x28\x00\x29\x00\xbe\x00\x26\x00\x60\x00\x3e\x00\x87\x00\x3e\x00\x87\x00\x6d\x00\x6d\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xe8\x00\xd4\x00\x27\x00\x36\x00\x29\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x6d\x00\x6a\x00\xd5\x00\x37\x00\x97\x00\x29\x00\x3f\x00\x23\x00\x26\x00\x26\x00\x6a\x00\xd7\x00\x91\x00\x6f\x00\x45\x00\x46\x00\x47\x00\xda\x00\xc7\x00\x45\x00\x46\x00\x47\x00\xd3\x00\xb0\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x63\x00\x6a\x00\x92\x00\x59\x00\x45\x00\x46\x00\x47\x00\xd1\x00\x48\x00\xba\x00\xbb\x00\x4e\x00\xaf\x00\xdc\x00\xa2\x00\x59\x00\x4e\x00\xb4\x00\xbc\x00\xa3\x00\x93\x00\x4e\x00\x4f\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\x41\x00\x42\x00\x43\x00\x44\x00\x5c\x00\x6a\x00\xcb\x00\x59\x00\xf0\x00\x46\x00\x47\x00\xab\x00\x94\x00\xc8\x00\x46\x00\x47\x00\x3a\x00\xdd\x00\xb1\x00\x46\x00\x47\x00\x3a\x00\x95\x00\x52\x00\x46\x00\x47\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\xc5\x00\x3d\x00\x9d\x00\x59\x00\x63\x00\x3c\x00\x3d\x00\x5a\x00\x9e\x00\x38\x00\x63\x00\x81\x00\x82\x00\x6a\x00\x80\x00\x51\x00\x47\x00\x71\x00\x69\x00\x63\x00\xe2\x00\x50\x00\xac\x00\x71\x00\x69\x00\x9c\x00\x63\x00\xdf\x00\x63\x00\x80\x00\x63\x00\x9f\x00\x71\x00\x69\x00\x7f\x00\x63\x00\x80\x00\xad\x00\x70\x00\x71\x00\x69\x00\x71\x00\x69\x00\x9a\x00\x69\x00\x6d\x00\x6a\x00\x6a\x00\x68\x00\x69\x00\x6a\x00\x99\x00\x56\x00\xbc\x00\x9a\x00\xba\x00\xbb\x00\x6e\x00\x6f\x00\xa1\x00\x23\x00\xbd\x00\x6b\x00\x26\x00\xbc\x00\x53\x00\x62\x00\xff\xff\x5c\x00\x7e\x00\xcc\x00\x5c\x00\x58\x00\x5d\x00\x59\x00\x61\x00\xf9\x00\xf8\x00\x4c\x00\xf6\x00\xee\x00\xef\x00\xf3\x00\x3a\x00\x23\x00\xeb\x00\xec\x00\xc2\x00\xc4\x00\xca\x00\x4c\x00\xed\x00\xc3\x00\x5c\x00\xcb\x00\x5f\x00\xd9\x00\x23\x00\xce\x00\x26\x00\xd3\x00\x8f\x00\xdc\x00\x4c\x00\x26\x00\x23\x00\x23\x00\x8e\x00\x91\x00\xa1\x00\x26\x00\x3a\x00\xa7\x00\xff\xff\xa6\x00\xff\xff\xff\xff\xff\xff\xa8\x00\xaa\x00\xab\x00\x5c\x00\x00\x00\x26\x00\x97\x00\xb3\x00\xb4\x00\xb6\x00\x00\x00\x90\x00\x26\x00\x5c\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x26\x00\x23\x00\x00\x00\x26\x00\x00\x00\xff\xff\x5f\x00\x00\x00\x00\x00\x5f\x00\x4c\x00\xff\xff\x00\x00\x23\x00\xb7\x00\xff\xff\xff\xff\x00\x00\x3a\x00\xff\xff\xff\xff\x23\x00\xff\xff\x00\x00\x23\x00\xff\xff\xb9\x00\x00\x00\xff\xff\x00\x00\x00\x00\x26\x00\x23\x00\x00\x00\x26\x00\x00\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\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 = 47 :: 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 46# 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#; _ -> happyError' (tk:tks) } happyError_ 46# 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 "" #-} {-# LINE 10 "" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4 # 17 "/usr/include/stdc-predef.h" 3 4 {-# LINE 10 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp {-# LINE 13 "templates/GenericTemplate.hs" #-} -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) #define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) #define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) #else #define LT(n,m) (n Happy_GHC_Exts.<# m) #define GTE(n,m) (n Happy_GHC_Exts.>=# m) #define EQ(n,m) (n Happy_GHC_Exts.==# m) #endif {-# LINE 46 "templates/GenericTemplate.hs" #-} data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList {-# LINE 67 "templates/GenericTemplate.hs" #-} {-# LINE 77 "templates/GenericTemplate.hs" #-} {-# LINE 86 "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 | LT(n,(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 GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) then EQ(indexShortOffAddr happyCheck off_i, i) else False action | check = indexShortOffAddr happyTable off_i | otherwise = indexShortOffAddr happyDefActions st 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 170 "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 = case happyDrop k (HappyCons (st) (sts)) of sts1@((HappyCons (st1@(action)) (_))) -> let drop_stk = happyDropStk k stk in happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_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 = case happyDrop k (HappyCons (st) (sts)) of sts1@((HappyCons (st1@(action)) (_))) -> let drop_stk = happyDropStk k stk off = indexShortOffAddr happyGotoOffsets st1 off_i = (off Happy_GHC_Exts.+# nt) new_state = indexShortOffAddr happyTable off_i in happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) 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.8.1/dist/build/unit-tests/0000755000000000000000000000000012654616013014605 5ustar0000000000000000BNFC-2.8.1/dist/build/unit-tests/unit-tests-tmp/0000755000000000000000000000000012654616013017522 5ustar0000000000000000BNFC-2.8.1/dist/build/unit-tests/unit-tests-tmp/LexBNF.hs0000644000000000000000000015033212654616013021140 0ustar0000000000000000{-# LANGUAGE CPP,MagicHash #-} {-# LINE 3 "src/LexBNF.x" #-} {-# OPTIONS -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -w #-} module LexBNF where import qualified Data.Bits import Data.Word (Word8) import Data.Char (ord) #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\xc9\xff\xff\xff\xe0\xff\xff\xff\xc9\x00\x00\x00\x9c\x01\x00\x00\x2d\x00\x00\x00\x1c\x02\x00\x00\x1c\x03\x00\x00\x0a\x01\x00\x00\x00\x00\x00\x00\x0d\x03\x00\x00\x0d\x04\x00\x00\xcd\x03\x00\x00\xcd\x04\x00\x00\x91\x05\x00\x00\xef\x05\x00\x00\x8d\x04\x00\x00\x00\x00\x00\x00\xa5\x05\x00\x00\xdb\xff\xff\xff\x47\x00\x00\x00\x5a\x00\x00\x00\xa5\x06\x00\x00\xa6\x06\x00\x00\x69\x07\x00\x00\x29\x07\x00\x00\x00\x00\x00\x00\x1f\x08\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\xf8\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x00\x00\x00\xe7\x05\x00\x00\x7c\x00\x00\x00"# alex_table :: AlexAddr alex_table = AlexA# "\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x21\x00\x25\x00\x16\x00\x1c\x00\x05\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x02\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x1f\x00\x21\x00\x00\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x22\x00\x21\x00\x00\x00\x21\x00\x00\x00\x21\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x21\x00\x03\x00\x21\x00\x00\x00\x21\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x20\x00\x21\x00\x21\x00\x01\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x03\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x03\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\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\x08\x00\x09\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\x19\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\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\x08\x00\x09\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\x04\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x06\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\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\x0c\x00\x0d\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\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x1a\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\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x24\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x10\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x0f\x00\x11\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\x19\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1a\x00\x04\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x13\x00\x07\x00\x0a\x00\x0a\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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\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\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\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\x05\x00\xff\xff\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\x05\x00\x05\x00\x12\x00\x12\x00\x03\x00\x03\x00\xff\xff\x17\x00\xff\xff\x17\x00\x1b\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1c\x00\x1c\x00\x1c\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,40) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,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 39 "src/LexBNF.x" #-} tok :: (Posn -> String -> Token) -> (Posn -> String -> Token) 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 :: [Token] -> String tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l tokenPos (Err (Pn _ l _) :_) = "line " ++ show l tokenPos _ = "end of file" tokenPosn :: Token -> Posn tokenPosn (PT p _) = p tokenPosn (Err p) = p tokenLineCol :: Token -> (Int, Int) tokenLineCol = posLineCol . tokenPosn posLineCol :: Posn -> (Int, Int) posLineCol (Pn _ l c) = (l,c) mkPosToken :: Token -> ((Int, Int), String) mkPosToken t@(PT p _) = (posLineCol p, prToken t) prToken :: Token -> String 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 Err _ -> "#Error" 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 :: BTree 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 "" #-} {-# LINE 9 "" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4 # 17 "/usr/include/stdc-predef.h" 3 4 {-# LINE 9 "" #-} {-# 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 21 "templates/GenericTemplate.hs" #-} -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) #else #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif {-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #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) -> case fromIntegral c of { (I# (ord_c)) -> let base = alexIndexInt32OffAddr alex_base s offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset new_s = if GTE(offset,0#) && EQ(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 (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) {-# LINE 198 "templates/GenericTemplate.hs" #-} 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 = AlexAccNone | AlexAcc a | AlexAccSkip {-# LINE 242 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i BNFC-2.8.1/dist/build/unit-tests/unit-tests-tmp/ParBNF.hs0000644000000000000000000020027012654616013021127 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 import Control.Applicative(Applicative(..)) import Control.Monad (ap) -- parser produced by Happy Version 1.19.5 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# "\x45\x00\x45\x00\x45\x00\x64\x00\x64\x00\x00\x00\x64\x00\xbc\x00\xbd\x00\x71\x00\x71\x00\xda\x01\xd9\x01\xd8\x01\xd6\x01\xd7\x01\x7e\x01\xd5\x01\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\xd4\x01\x00\x00\x00\x00\xd3\x01\x29\x00\x29\x00\x29\x00\x29\x00\xd2\x01\xcc\x01\x00\x00\xd1\x01\xcb\x01\x00\x00\x00\x00\x11\x00\xd0\x01\x89\x01\xc8\x01\x29\x00\xc9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x01\x00\x00\x3e\x00\xe2\xff\x01\x00\xc5\x01\x00\x00\xbc\x00\xc5\x01\xc5\x01\xc4\x01\xcf\x01\xc3\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\xce\x01\xca\x01\x00\x00\xc2\x01\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x07\x00\xc2\x01\xc2\x01\xc2\x01\xc2\x01\x6a\x01\x00\x00\xc2\x01\xc2\x01\xc1\x01\xc1\x01\xcd\x01\xbf\x01\xc0\x01\xc7\x01\xbe\x01\xbc\x01\xc6\x01\xba\x01\xba\x01\xba\x01\x00\x00\xba\x01\xbd\x01\xb9\x01\x00\x00\xb4\x01\x5e\x00\x00\x00\xb4\x01\xbd\x00\x00\x00\xb4\x01\x00\x00\xb4\x01\xbb\x01\xb6\x01\xb5\x01\xb3\x01\xbd\x00\xb3\x01\x44\x00\x68\x01\xaf\x01\xad\x01\xa8\x01\xa8\x01\xa6\x01\x7c\x00\x9c\x01\xb7\x01\x9b\x01\x00\x00\x8b\x00\xb0\x01\x9a\x01\x00\x00\xb8\x01\x99\x01\x98\x01\x98\x01\x00\x00\x00\x00\x64\x00\x45\x00\x93\x01\x64\x00\x00\x00\x29\x00\xbd\x00\xbd\x00\xb2\x01\x8e\x01\x00\x00\x96\x01\x00\x00\xae\x01\x00\x00\x95\x01\x00\x00\x95\x01\x91\x01\xbd\x00\xab\x01\xb1\x01\x00\x00\xfe\xff\x00\x00\x6e\x00\x84\x01\xa9\x01\xa7\x01\xa7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x01\xac\x01\x07\x00\x07\x00\x00\x00\x8d\x01\x00\x00\x10\x01\x29\x00\x00\x00\x00\x00\x00\x00\x85\x01\xa3\x01\xaa\x01\x29\x00\x29\x00\x00\x00\x00\x00\x00\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x01\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x01\x00\x00\x00\x00\xa1\x01\x00\x00\x00\x00\xf6\xff\x80\x01\xbd\x00\x00\x00\x29\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\x9e\x01\x7e\x01\x07\x00\x00\x00\xa4\x01\xa0\x01\x97\x01\x00\x00\xbc\x00\x00\x00\x8c\x01\x00\x00\xbc\x00\x00\x00\x78\x01\x94\x01\x9f\x01\x00\x00\x00\x00"# happyGotoOffsets :: HappyAddr happyGotoOffsets = HappyA# "\x86\x00\xa3\x00\xa1\x00\x58\x01\x6e\x01\x90\x01\x70\x01\x82\x01\x86\x01\x77\x01\x06\x00\x87\x01\x8f\x01\xb2\x00\x8b\x01\x48\x01\x74\x01\x0c\x00\x7f\x01\x30\x01\x4b\x01\x50\x01\x05\x01\xf6\x00\xc7\x00\x3c\x01\x31\x00\x3e\x01\xc0\x00\xb0\x00\x46\x00\xaa\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x92\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x01\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x01\xd9\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x7a\x01\x6b\x01\x28\x01\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x01\x00\x00\x00\x00\x83\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x01\x5d\x01\x56\x01\x61\x01\x22\x00\x72\x01\xc5\x00\x00\x00\x46\x01\x1d\x01\xfe\x00\x0b\x01\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x01\x91\x00\x04\x00\x67\x01\x00\x00\x9a\x00\x35\x01\x0a\x01\x00\x00\xee\x00\x00\x00\x79\x00\x00\x00\x00\x00\x00\x00\xe9\x00\xfc\xff\xe0\x00\xce\x00\xe7\x00\x00\x00\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x88\x01\x24\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x01\xd4\x00\x00\x00\x4b\x00\x37\x01\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\xcf\x00\x02\x00\x00\x00\x96\x00\x42\x00\xb5\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x00\x21\x01\x94\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\x00\x00\x00\xec\xff\x13\x00\xde\x00\x00\x00\x72\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\x0b\x00\x01\x00\x01\x00\x01\x00\x01\x00\x08\x00\x01\x00\x01\x00\x27\x00\x01\x00\x0d\x00\x20\x00\x01\x00\x0d\x00\x0d\x00\x2e\x00\x10\x00\x01\x00\x17\x00\x0d\x00\x0f\x00\x15\x00\x06\x00\x17\x00\x16\x00\x03\x00\x1a\x00\x1b\x00\x0a\x00\x0d\x00\x03\x00\x2a\x00\x10\x00\x16\x00\x01\x00\x01\x00\x24\x00\x15\x00\x26\x00\x17\x00\x25\x00\x01\x00\x1a\x00\x1b\x00\x2c\x00\x25\x00\x2e\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x24\x00\x0d\x00\x26\x00\x21\x00\x10\x00\x23\x00\x0a\x00\x03\x00\x2c\x00\x15\x00\x23\x00\x17\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x01\x00\x01\x00\x25\x00\x25\x00\x03\x00\x0c\x00\x00\x00\x0a\x00\x24\x00\x00\x00\x26\x00\x1f\x00\x0d\x00\x0d\x00\x0f\x00\x0f\x00\x2c\x00\x11\x00\x12\x00\x13\x00\x14\x00\x21\x00\x16\x00\x23\x00\x18\x00\x19\x00\x01\x00\x1e\x00\x1f\x00\x1d\x00\x1e\x00\x1f\x00\x01\x00\x21\x00\x22\x00\x1d\x00\x23\x00\x25\x00\x0d\x00\x2e\x00\x0f\x00\x2a\x00\x2a\x00\x02\x00\x0d\x00\x01\x00\x0f\x00\x02\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x16\x00\x0d\x00\x18\x00\x19\x00\x0d\x00\x02\x00\x0f\x00\x1d\x00\x1e\x00\x1f\x00\x12\x00\x21\x00\x22\x00\x01\x00\x2a\x00\x0d\x00\x02\x00\x05\x00\x06\x00\x07\x00\x2a\x00\x12\x00\x05\x00\x0b\x00\x01\x00\x08\x00\x0e\x00\x0f\x00\x1d\x00\x06\x00\x07\x00\x03\x00\x12\x00\x2a\x00\x0b\x00\x03\x00\x0a\x00\x0e\x00\x0f\x00\x03\x00\x01\x00\x15\x00\x01\x00\x29\x00\x2a\x00\x06\x00\x07\x00\x06\x00\x2e\x00\x25\x00\x0b\x00\x03\x00\x0b\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x03\x00\x02\x00\x00\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\x03\x00\x12\x00\x00\x00\x25\x00\x00\x00\x25\x00\x0d\x00\x0d\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x02\x00\x21\x00\x22\x00\x23\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\x00\x00\x21\x00\x1d\x00\x23\x00\x1d\x00\x29\x00\x2a\x00\x2a\x00\x01\x00\x00\x00\x0c\x00\x0d\x00\x18\x00\x19\x00\x1a\x00\x01\x00\x1c\x00\x18\x00\x19\x00\x1a\x00\x0d\x00\x1c\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\x01\x00\x01\x00\x10\x00\x18\x00\x19\x00\x1a\x00\x14\x00\x1c\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x0d\x00\x0f\x00\x10\x00\x1a\x00\x1b\x00\x0c\x00\x14\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\x11\x00\x01\x00\x13\x00\x10\x00\x18\x00\x19\x00\x1a\x00\x14\x00\x20\x00\x18\x00\x19\x00\x1a\x00\x0a\x00\x0d\x00\x18\x00\x19\x00\x1a\x00\x0a\x00\x01\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\x1e\x00\x1f\x00\x01\x00\x10\x00\x01\x00\x1e\x00\x1f\x00\x14\x00\x00\x00\x20\x00\x01\x00\x08\x00\x09\x00\x01\x00\x0b\x00\x19\x00\x1a\x00\x0e\x00\x0f\x00\x01\x00\x0b\x00\x1a\x00\x00\x00\x0e\x00\x0f\x00\x0d\x00\x01\x00\x09\x00\x01\x00\x0b\x00\x01\x00\x01\x00\x0e\x00\x0f\x00\x09\x00\x01\x00\x0b\x00\x00\x00\x0b\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x00\x00\x01\x00\x01\x00\x0e\x00\x0f\x00\x01\x00\x20\x00\x15\x00\x00\x00\x23\x00\x03\x00\x04\x00\x0c\x00\x0d\x00\x0d\x00\x29\x00\x00\x00\x0d\x00\x2a\x00\x0c\x00\x17\x00\x10\x00\x2e\x00\x11\x00\x0a\x00\x13\x00\x11\x00\x1f\x00\x13\x00\x21\x00\x11\x00\x02\x00\x0e\x00\x2b\x00\x0d\x00\x05\x00\x02\x00\x09\x00\x1c\x00\x29\x00\x09\x00\x0e\x00\x02\x00\x28\x00\x02\x00\x2b\x00\x0e\x00\x0e\x00\x01\x00\x0e\x00\x0d\x00\x07\x00\x29\x00\x0e\x00\x2a\x00\x0e\x00\x0a\x00\x09\x00\x2b\x00\x2a\x00\x29\x00\x29\x00\x08\x00\x0a\x00\x07\x00\x2a\x00\x1c\x00\x08\x00\x2e\x00\x0e\x00\x2e\x00\x2e\x00\x2e\x00\x05\x00\x05\x00\x0d\x00\x01\x00\xff\xff\x2a\x00\x22\x00\x08\x00\x05\x00\x05\x00\xff\xff\x05\x00\x2a\x00\x01\x00\xff\xff\xff\xff\x01\x00\xff\xff\x2a\x00\x29\x00\xff\xff\x2a\x00\xff\xff\x2e\x00\x0d\x00\xff\xff\xff\xff\x0d\x00\x2b\x00\x2e\x00\xff\xff\x29\x00\x27\x00\x2e\x00\x2e\x00\xff\xff\x1c\x00\x2e\x00\x2e\x00\x29\x00\x2e\x00\xff\xff\x29\x00\x2e\x00\x27\x00\xff\xff\x2e\x00\xff\xff\xff\xff\x2a\x00\x29\x00\xff\xff\x2a\x00\xff\xff\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\xff\xff"# happyTable :: HappyAddr happyTable = HappyA# "\x00\x00\xea\x00\x2c\x00\x6a\x00\x54\x00\x23\x00\xa7\x00\x63\x00\x4a\x00\xb9\x00\x23\x00\xab\x00\xf4\x00\x54\x00\x2d\x00\xe7\x00\xff\xff\x2e\x00\x2c\x00\xd6\x00\x4b\x00\x64\x00\x2f\x00\xc0\x00\x30\x00\xae\x00\x26\x00\x31\x00\x32\x00\xf3\x00\x2d\x00\x26\x00\x26\x00\x2e\x00\x55\x00\x23\x00\x23\x00\x33\x00\x2f\x00\x34\x00\x30\x00\xe0\x00\x2c\x00\x31\x00\x32\x00\x35\x00\x8c\x00\xff\xff\x23\x00\x26\x00\x4c\x00\x35\x00\x4d\x00\x33\x00\x2d\x00\x34\x00\xc0\x00\x2e\x00\x29\x00\x3a\x00\x26\x00\x35\x00\x2f\x00\xb7\x00\x30\x00\xba\x00\xbb\x00\x31\x00\x32\x00\x66\x00\x66\x00\x9b\x00\x24\x00\x26\x00\xbc\x00\x3e\x00\x3a\x00\x33\x00\xe3\x00\x34\x00\x3b\x00\x67\x00\x67\x00\x68\x00\x68\x00\x35\x00\x73\x00\x74\x00\x75\x00\x76\x00\xc4\x00\x77\x00\x29\x00\x78\x00\x79\x00\xa5\x00\xe5\x00\x3d\x00\x7a\x00\x7b\x00\x7c\x00\x66\x00\x7d\x00\x7e\x00\xc6\x00\x35\x00\x89\x00\x67\x00\xff\xff\x68\x00\x26\x00\x26\x00\xd0\x00\x67\x00\x66\x00\x68\x00\x5f\x00\x73\x00\x74\x00\x75\x00\x76\x00\x3e\x00\x77\x00\xd1\x00\x78\x00\x79\x00\x67\x00\x5f\x00\x68\x00\x7a\x00\x7b\x00\x7c\x00\xf6\x00\x7d\x00\x7e\x00\x83\x00\x26\x00\x6d\x00\x5f\x00\x8a\x00\x84\x00\x8b\x00\x26\x00\xce\x00\x90\x00\x86\x00\x83\x00\x75\xff\x71\x00\x69\x00\xd9\x00\x84\x00\xe1\x00\x26\x00\xa8\x00\x26\x00\x86\x00\x26\x00\xef\x00\x71\x00\x69\x00\x26\x00\x83\x00\xf1\x00\x83\x00\x23\x00\x26\x00\x84\x00\x85\x00\x89\x00\xff\xff\x87\x00\x86\x00\x26\x00\x86\x00\x71\x00\x69\x00\x71\x00\x69\x00\x26\x00\x5f\x00\xe4\x00\x87\x00\x27\x00\x28\x00\x29\x00\xe6\x00\x27\x00\x28\x00\x29\x00\xde\x00\x27\x00\x28\x00\x29\x00\xbe\x00\x26\x00\x60\x00\x3e\x00\x87\x00\x3e\x00\x87\x00\x6d\x00\x6d\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xe8\x00\xd4\x00\x27\x00\x36\x00\x29\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x6d\x00\x6a\x00\xd5\x00\x37\x00\x97\x00\x29\x00\x3f\x00\x23\x00\x26\x00\x26\x00\x6a\x00\xd7\x00\x91\x00\x6f\x00\x45\x00\x46\x00\x47\x00\xda\x00\xc7\x00\x45\x00\x46\x00\x47\x00\xd3\x00\xb0\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x63\x00\x6a\x00\x92\x00\x59\x00\x45\x00\x46\x00\x47\x00\xd1\x00\x48\x00\xba\x00\xbb\x00\x4e\x00\xaf\x00\xdc\x00\xa2\x00\x59\x00\x4e\x00\xb4\x00\xbc\x00\xa3\x00\x93\x00\x4e\x00\x4f\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\x41\x00\x42\x00\x43\x00\x44\x00\x5c\x00\x6a\x00\xcb\x00\x59\x00\xf0\x00\x46\x00\x47\x00\xab\x00\x94\x00\xc8\x00\x46\x00\x47\x00\x3a\x00\xdd\x00\xb1\x00\x46\x00\x47\x00\x3a\x00\x95\x00\x52\x00\x46\x00\x47\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\xc5\x00\x3d\x00\x9d\x00\x59\x00\x63\x00\x3c\x00\x3d\x00\x5a\x00\x9e\x00\x38\x00\x63\x00\x81\x00\x82\x00\x6a\x00\x80\x00\x51\x00\x47\x00\x71\x00\x69\x00\x63\x00\xe2\x00\x50\x00\xac\x00\x71\x00\x69\x00\x9c\x00\x63\x00\xdf\x00\x63\x00\x80\x00\x63\x00\x9f\x00\x71\x00\x69\x00\x7f\x00\x63\x00\x80\x00\xad\x00\x70\x00\x71\x00\x69\x00\x71\x00\x69\x00\x9a\x00\x69\x00\x6d\x00\x6a\x00\x6a\x00\x68\x00\x69\x00\x6a\x00\x99\x00\x56\x00\xbc\x00\x9a\x00\xba\x00\xbb\x00\x6e\x00\x6f\x00\xa1\x00\x23\x00\xbd\x00\x6b\x00\x26\x00\xbc\x00\x53\x00\x62\x00\xff\xff\x5c\x00\x7e\x00\xcc\x00\x5c\x00\x58\x00\x5d\x00\x59\x00\x61\x00\xf9\x00\xf8\x00\x4c\x00\xf6\x00\xee\x00\xef\x00\xf3\x00\x3a\x00\x23\x00\xeb\x00\xec\x00\xc2\x00\xc4\x00\xca\x00\x4c\x00\xed\x00\xc3\x00\x5c\x00\xcb\x00\x5f\x00\xd9\x00\x23\x00\xce\x00\x26\x00\xd3\x00\x8f\x00\xdc\x00\x4c\x00\x26\x00\x23\x00\x23\x00\x8e\x00\x91\x00\xa1\x00\x26\x00\x3a\x00\xa7\x00\xff\xff\xa6\x00\xff\xff\xff\xff\xff\xff\xa8\x00\xaa\x00\xab\x00\x5c\x00\x00\x00\x26\x00\x97\x00\xb3\x00\xb4\x00\xb6\x00\x00\x00\x90\x00\x26\x00\x5c\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x26\x00\x23\x00\x00\x00\x26\x00\x00\x00\xff\xff\x5f\x00\x00\x00\x00\x00\x5f\x00\x4c\x00\xff\xff\x00\x00\x23\x00\xb7\x00\xff\xff\xff\xff\x00\x00\x3a\x00\xff\xff\xff\xff\x23\x00\xff\xff\x00\x00\x23\x00\xff\xff\xb9\x00\x00\x00\xff\xff\x00\x00\x00\x00\x26\x00\x23\x00\x00\x00\x26\x00\x00\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\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 = 47 :: 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 46# 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#; _ -> happyError' (tk:tks) } happyError_ 46# 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 "" #-} {-# LINE 10 "" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4 # 17 "/usr/include/stdc-predef.h" 3 4 {-# LINE 10 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp {-# LINE 13 "templates/GenericTemplate.hs" #-} -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) #define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) #define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) #else #define LT(n,m) (n Happy_GHC_Exts.<# m) #define GTE(n,m) (n Happy_GHC_Exts.>=# m) #define EQ(n,m) (n Happy_GHC_Exts.==# m) #endif {-# LINE 46 "templates/GenericTemplate.hs" #-} data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList {-# LINE 67 "templates/GenericTemplate.hs" #-} {-# LINE 77 "templates/GenericTemplate.hs" #-} {-# LINE 86 "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 | LT(n,(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 GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) then EQ(indexShortOffAddr happyCheck off_i, i) else False action | check = indexShortOffAddr happyTable off_i | otherwise = indexShortOffAddr happyDefActions st 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 170 "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 = case happyDrop k (HappyCons (st) (sts)) of sts1@((HappyCons (st1@(action)) (_))) -> let drop_stk = happyDropStk k stk in happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_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 = case happyDrop k (HappyCons (st) (sts)) of sts1@((HappyCons (st1@(action)) (_))) -> let drop_stk = happyDropStk k stk off = indexShortOffAddr happyGotoOffsets st1 off_i = (off Happy_GHC_Exts.+# nt) new_state = indexShortOffAddr happyTable off_i in happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) 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.8.1/runtime/0000755000000000000000000000000012654616013012107 5ustar0000000000000000BNFC-2.8.1/runtime/Algebra/0000755000000000000000000000000012654616013013444 5ustar0000000000000000BNFC-2.8.1/runtime/Algebra/RingUtils.hs0000644000000000000000000000277712654616013015735 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.8.1/runtime/Data/0000755000000000000000000000000012654616013012760 5ustar0000000000000000BNFC-2.8.1/runtime/Data/Matrix/0000755000000000000000000000000012654616013014224 5ustar0000000000000000BNFC-2.8.1/runtime/Data/Matrix/Class.hs0000644000000000000000000000410012654616013015620 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 BNFC-2.8.1/runtime/Data/Matrix/Quad.hs0000644000000000000000000002543112654616013015457 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,concat) 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) sparse :: AbelianGroup a => Shape' x -> Shape' y -> Mat x y a -> [(Int,Int,a)] sparse x y Zero = [] sparse _ _ (One x) = [(0,0,x)] sparse (Bin' _ x x') (Bin' _ y y') (Quad a b c d) = sparse x y a ++ shiftX x (sparse x' y b) ++ shiftY y (sparse x y' c) ++ shiftX x (shiftY y(sparse x' y' d)) sparse Leaf' (Bin' _ y y') (Col a b) = sparse Leaf' y a ++ shiftY y (sparse Leaf' y' b) sparse (Bin' _ x x') Leaf' (Row a b) = sparse x Leaf' a ++ shiftX x (sparse x' Leaf' b) shiftX x0 as = [(x+sz' x0,y,a) | (x,y,a) <- as] shiftY y0 as = [(x,y+sz' y0,a) | (x,y,a) <- as] 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' scatterplot (T s (m :/: m')) = concat [show x ++ " " ++ show y ++ "\n" | (x,y,_) <- sparse s s m ++ sparse s s m'] BNFC-2.8.1/runtime/Parsing/0000755000000000000000000000000012654616013013512 5ustar0000000000000000BNFC-2.8.1/runtime/Parsing/Chart.hs0000644000000000000000000000341212654616013015107 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.8.1/runtime/Parsing/TestProgram.hs0000644000000000000000000000477012654616013016325 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 "stdin" 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 f v run f 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 when (v >= 2) $ do writeFile (f ++ ".xpm") (genXPM $ fingerprint chart) let scatt = scatterplot chart putStrLn $ "Scatterplot data size:" ++ show (length scatt) writeFile (f ++ ".data") scatt 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.8.1/test/0000755000000000000000000000000012654616013011403 5ustar0000000000000000BNFC-2.8.1/test/unit-tests.hs0000644000000000000000000000005412654616013014055 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} BNFC-2.8.1/test/doctests.hs0000644000000000000000000000027612654616013013574 0ustar0000000000000000import Test.DocTest main = doctest [ "-isrc" , "-idist/build/autogen/" , "-idist/build/bnfc/bnfc-tmp" , "-XOverloadedStrings" , "-XRecordWildCards" , "src/Main.hs" ] BNFC-2.8.1/test/BNFC/0000755000000000000000000000000012654616013012113 5ustar0000000000000000BNFC-2.8.1/test/BNFC/OptionsSpec.hs0000644000000000000000000001073712654616013014725 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, UndecidableInstances #-} module BNFC.OptionsSpec where import Control.Monad (liftM, liftM2) import Data.List (intercalate) import Data.Maybe (fromJust) import System.Console.GetOpt import System.FilePath ((<.>), takeBaseName) import Test.Hspec import Test.QuickCheck import BNFC.Options -- SUT import BNFC.WarningM -- Expectation that a particular option has a particular value shouldSet :: (Eq a, Show a) => Mode -> (SharedOptions -> a, a) -> Expectation shouldSet (Target opts _) (option, value) = option opts `shouldBe` value spec :: Spec spec = do describe "parseMode" $ do it "returns Help on an empty list of arguments" $ parseMode [] `shouldBe` Help it "returns Help if given --help" $ parseMode ["--help"] `shouldBe` Help it "returns Version if given --version" $ parseMode ["--version"] `shouldBe` Version it "returns an error if help is given an argument" $ isUsageError (parseMode ["--help=2"]) `shouldBe` True it "If no language is specified, it should default to haskell" $ parseMode["file.cf"] `shouldSet` (target, TargetHaskell) it "returns an error if the grammar file is missing" $ parseMode["--haskell"] `shouldBe` UsageError "Missing grammar file" it "returns an error if multiple grammar files are given" $ parseMode["--haskell", "file1.cf", "file2.cf"] `shouldBe` UsageError "Too many arguments" it "sets the language name to the basename of the grammar file" $ parseMode["foo.cf"] `shouldSet` (lang, "foo") it "accept 'old style' options" $ do parseMode["-haskell", "-m", "-glr", "file.cf"] `shouldSet` (target, TargetHaskell) parseMode["-haskell", "-m", "-glr", "file.cf"] `shouldSet` (make, Just "Makefile") parseMode["-haskell", "-m", "-glr", "file.cf"] `shouldSet` (glr, GLR) it "accept latex as a target language" $ parseMode["--latex", "file.cf"] `shouldSet` (target, TargetLatex) describe "Old option translation" $ do it "translate -haskell to --haskell" $ translateOldOptions ["-haskell"] `shouldBe` ["--haskell"] describe "--makefile" $ do it "is off by default" $ parseMode["--c", "foo.cf"] `shouldSet` (make, Nothing) it "uses the file name 'Makefile' by default" $ parseMode["--c", "-m", "foo.cf"] `shouldSet` (make, Just "Makefile") context "when using the option with an argument" $ it "uses the argument as Makefile name" $ parseMode["--c", "-mMyMakefile", "foo.cf"] `shouldSet` (make, Just "MyMakefile") -- ~~~ Arbitrary instances ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ randomOption :: Gen String randomOption = oneof [ nonOption, noArg, withArg ] where nonOption = stringOf1 ['a'..'z'] -- non-option argument noArg = liftM ("--"++) nonOption -- flag withArg = do arg <- nonOption flag <- noArg return $ flag ++ "=" ++ arg -- Helper function that generates a string of random length using the given -- set of characters. Not that the type signature explicitely uses -- [Char] and not String for documentation purposes stringOf :: [Char] -> Gen String stringOf = listOf . elements -- | Same as stringOf but only generates non empty strings stringOf1 :: [Char] -> Gen String stringOf1 = listOf1 . elements instance Arbitrary Target where arbitrary = elements [minBound .. ] -- creates a filepath with the given extension arbitraryFilePath :: String -> Gen FilePath arbitraryFilePath ext = do path <- listOf1 $ stringOf1 ['a'..'z'] return $ intercalate "/" path <.> ext -- Generates unix command line options. Can be in long form (ex: --option) -- or short form (ex: -o) -- Note: we only use letters x,y,z to make (almost) sure that we are not -- going to generate accidentally an global/target language option arbitraryOption :: Gen String arbitraryOption = oneof [arbitraryShortOption, arbitraryLongOption] where arbitraryShortOption = liftM (('-':) . (:[])) (elements ['x'..'z']) arbitraryLongOption = liftM ("--" ++) (stringOf1 ['x'..'z']) -- Arbitrary instance for Mode instance Arbitrary Mode where arbitrary = oneof [ return Help , return Version , liftM UsageError arbitrary -- generates a random error message , do target' <- arbitrary -- random target cfFile <- arbitraryFilePath "cf" let args = defaultOptions { lang = takeBaseName cfFile, target = target'} return $ Target args cfFile ] BNFC-2.8.1/test/BNFC/WarningMSpec.hs0000644000000000000000000000135312654616013015006 0ustar0000000000000000module BNFC.WarningMSpec where import Test.Hspec import BNFC.WarningM -- SUT spec :: Spec spec = do describe "run" $ do it "returns the result of the computation and all raised warnings" $ run computationWithWarnings `shouldBe` (3,["Coucou", "Hi"]) describe "putWarnings" $ do it "returns the result of the computation" $ do putWarnings computationWithWarnings `shouldReturn` 3 describe "hasWarnings" $ do it "returns true if the computation has warnings" $ hasWarnings computationWithWarnings `shouldBe` True it "returns Fasle if the computation doesn't have any warnings" $ hasWarnings (return ()) `shouldBe` False where computationWithWarnings = warn "Coucou" >> warn "Hi" >> return 3 BNFC-2.8.1/test/BNFC/Backend/0000755000000000000000000000000012654616013013442 5ustar0000000000000000BNFC-2.8.1/test/BNFC/Backend/HaskellSpec.hs0000644000000000000000000000360112654616013016174 0ustar0000000000000000module BNFC.Backend.HaskellSpec where import Test.Hspec import BNFC.GetCF import BNFC.Hspec import BNFC.Options hiding (Backend) import BNFC.Backend.Base import Text.Printf (printf) import BNFC.Backend.Haskell -- SUT calcOptions = defaultOptions { lang = "Calc" } getCalc = parseCF calcOptions TargetHaskell $ unlines [ "EAdd. Exp ::= Exp \"+\" Exp1 ;" , "ESub. Exp ::= Exp \"-\" Exp1 ;" , "EMul. Exp1 ::= Exp1 \"*\" Exp2 ;" , "EDiv. Exp1 ::= Exp1 \"/\" Exp2 ;" , "EInt. Exp2 ::= Integer ;" , "coercions Exp 2 ;" ] spec = do context "with default option and the Calc grammar" $ do it "generates a file called AbsCalc.hs" $ do calc <- getCalc files <- execBackend (makeHaskell calcOptions calc) map fst files `shouldSatisfy` elem "AbsCalc.hs" it "generates a file called LexCalc.x" $ do calc <- getCalc files <- execBackend (makeHaskell calcOptions calc) map fst files `shouldSatisfy` elem "LexCalc.x" it "generates a file called ParCalc.y" $ do calc <- getCalc makeHaskell calcOptions calc `shouldGenerate` "ParCalc.y" it "generates a squeleton file" $ do calc <- getCalc makeHaskell calcOptions calc `shouldGenerate` "SkelCalc.hs" it "generates a pretty printer file" $ do calc <- getCalc makeHaskell calcOptions calc `shouldGenerate` "PrintCalc.hs" it "generates a test program file" $ do calc <- getCalc makeHaskell calcOptions calc `shouldGenerate` "TestCalc.hs" it "generates a error module file" $ do calc <- getCalc makeHaskell calcOptions calc `shouldGenerate` "ErrM.hs" context "with option -mMyMakefile and the Calc grammar" $ do it "generates a Makefile" $ do calc <- getCalc let options = calcOptions { make = Just "MyMakefile" } makeHaskell options calc `shouldGenerate` "MyMakefile" BNFC-2.8.1/test/BNFC/Backend/HaskellGADTSpec.hs0000644000000000000000000000134512654616013016637 0ustar0000000000000000module BNFC.Backend.HaskellGADTSpec where import BNFC.Options import BNFC.GetCF import Test.Hspec import BNFC.Hspec import BNFC.Backend.HaskellGADT -- SUT calcOptions = defaultOptions { lang = "Calc" } getCalc = parseCF calcOptions TargetHaskellGadt $ unlines [ "EAdd. Exp ::= Exp \"+\" Exp1 ;" , "ESub. Exp ::= Exp \"-\" Exp1 ;" , "EMul. Exp1 ::= Exp1 \"*\" Exp2 ;" , "EDiv. Exp1 ::= Exp1 \"/\" Exp2 ;" , "EInt. Exp2 ::= Integer ;" , "coercions Exp 2 ;" ] spec = describe "C backend" $ it "respect the makefile option" $ do calc <- getCalc let opts = calcOptions { make = Just "MyMakefile" } makeHaskellGadt opts calc `shouldGenerate` "MyMakefile" BNFC-2.8.1/test/BNFC/Backend/Haskell/0000755000000000000000000000000012654616013015025 5ustar0000000000000000BNFC-2.8.1/test/BNFC/Backend/Haskell/CFtoHappySpec.hs0000644000000000000000000000060112654616013020026 0ustar0000000000000000module BNFC.Backend.Haskell.CFtoHappySpec where import Test.Hspec import Text.PrettyPrint (render) import BNFC.Backend.Haskell.CFtoHappy rendersTo a b = render a `shouldBe` b spec = do describe "convert" $ do it "quotes backslashes" $ convert "\\" `rendersTo` "'\\\\'" it "quotes backslashes as part of a longer string" $ convert "/\\" `rendersTo` "'/\\\\'" BNFC-2.8.1/test/BNFC/Backend/Common/0000755000000000000000000000000012654616013014672 5ustar0000000000000000BNFC-2.8.1/test/BNFC/Backend/Common/MakefileSpec.hs0000644000000000000000000000153312654616013017560 0ustar0000000000000000module BNFC.Backend.Common.MakefileSpec where import Test.Hspec import BNFC.Backend.Base (execBackend) import BNFC.Options (defaultOptions,make) import BNFC.Backend.Common.Makefile -- SUT spec :: Spec spec = do describe "mkRule" $ do it "produces makefile rules correctly" $ mkRule "main" ["file1","file2"] ["do something"] "" `shouldBe` "main: file1 file2\n\tdo something\n\n" it "produce mafefile rules without receipes" $ mkRule "main" ["program.exe"] [] "" `shouldBe` "main: program.exe\n\n" describe "mkVar" $ it "writes variables" $ mkVar "FOO" "bar" "" `shouldBe` "FOO=bar\n" describe "mkMakefile" $ do it "uses the names in the options dictionary" $ let opts = defaultOptions { make = Just "MyMakefile" } in execBackend (mkMakefile opts "") `shouldReturn` [("MyMakefile","")]