diff --git a/BNFC.cabal b/BNFC.cabal --- a/BNFC.cabal +++ b/BNFC.cabal @@ -1,6 +1,6 @@ -cabal-version: >= 1.10 -Name: BNFC -Version: 2.5.0.1 + Name: BNFC +Version: 2.6.0.0 +cabal-version: >= 1.2 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). @@ -8,11 +8,10 @@ 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, + 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: @@ -22,38 +21,20 @@ 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 CHANGELOG.md +Extra-source-files: src/BNF.cf -tested-with: - GHC == 9.8.1 - GHC == 9.6.3 - GHC == 9.4.7 - GHC == 9.2.8 - GHC == 9.0.2 - GHC == 8.10.7 - GHC == 8.8.4 - GHC == 8.6.5 - GHC == 8.4.4 - GHC == 8.2.2 - GHC == 8.0.2 - GHC == 7.10.3 +Library + hs-source-dirs: runtime, src -Library - hs-source-dirs: runtime, src - default-language: Haskell2010 - Build-Depends: base>=4.8 && <5, array - exposed-modules: + exposed-modules: Algebra.RingUtils Data.Pair Data.Matrix.Quad - Data.Matrix.Class Parsing.Chart Parsing.TestProgram Executable bnfc - default-language: Haskell2010 - Build-Depends: base>=4.8 && <5, mtl, directory, array, process, containers, pretty >=1.1 && <1.2, filepath - build-tools: alex, happy + Build-Depends: base>=4.4 && <5, mtl, directory, array, process, containers, pretty >=1.1 && <1.2 Main-is: Main.hs HS-source-dirs: src src/formats src/formats/haskell2 @@ -69,7 +50,6 @@ src/formats/c-sharp src/formats/f-sharp Other-modules: - Paths_BNFC, LexBNF, ParBNF, AbsBNF, @@ -84,11 +64,7 @@ OOAbstract, CFtoLatex, CFtoXML, - CFtoTxt, - Options, - ToCNF, - Common.Makefile, - Data.Pair, + CFtoTxt, -- Haskell HaskellTop, RegToAlex, @@ -102,7 +78,6 @@ CFtoLayout, MkErrM, MkSharedString, - HsOpts, -- Profile ProfileTop, CFtoHappyProfile, @@ -178,76 +153,3 @@ CFtoCup15, -- F-sharp FSharpTop - -Flag haskell-tests - Description: Enable debug support - Default: True - -Test-suite system-tests-haskell - Type: exitcode-stdio-1.0 - default-language: Haskell2010 - Build-Depends: base>=4.8 && <5, - HUnit, test-framework, test-framework-hunit, - shelly, system-filepath, text - Main-is: system-tests-haskell.hs - HS-source-dirs: test/src - if flag(haskell-tests) - Buildable: True - else - Buildable: False - - -Flag java-tests - Description: Enable debug support - Default: True - -Test-suite system-tests-java - Type: exitcode-stdio-1.0 - default-language: Haskell2010 - Build-Depends: base>=4.8 && <5, - HUnit, test-framework, test-framework-hunit, - shelly, system-filepath, text - Main-is: system-tests-java.hs - HS-source-dirs: test/src - if flag(java-tests) - Buildable: True - else - Buildable: False - -Flag c-tests - Description: Enable debug support - Default: True - -Test-suite system-tests-c - Type: exitcode-stdio-1.0 - default-language: Haskell2010 - Build-Depends: base>=4.8 && <5, - HUnit, test-framework, test-framework-hunit, - shelly, system-filepath, text - Main-is: system-tests-c.hs - HS-source-dirs: test/src - if flag(c-tests) - Buildable: True - else - Buildable: False - - -Test-suite unit-tests - Type: exitcode-stdio-1.0 - default-language: Haskell2010 - Build-Depends: base>=4.8 && <5, mtl, directory, array, process, filepath, - HUnit, test-framework, test-framework-hunit - Main-is: unit-tests.hs - HS-source-dirs: src test/src src/formats - src/formats/haskell2 - src/formats/haskell-gadt - src/formats/xml - src/formats/profile - src/formats/java - src/formats/java1.5 - src/formats/cpp - src/formats/c - src/formats/ocaml - src/formats/cpp_stl - src/formats/c-sharp - src/formats/f-sharp diff --git a/CHANGELOG.md b/CHANGELOG.md deleted file mode 100644 --- a/CHANGELOG.md +++ /dev/null @@ -1,11 +0,0 @@ - -# 2.5.0.1 - -Andreas Abel , 2023-10-26 - -* Make BNFC 2.5 build with GHC ≥ 7.10 -* Tested with GHC 7.10.3 - 9.8.1 - -# 2.5 - -Gregoire Detrez, 2013-04-10 diff --git a/dist/build/bnfc/bnfc-tmp/LexBNF.hs b/dist/build/bnfc/bnfc-tmp/LexBNF.hs new file mode 100644 --- /dev/null +++ b/dist/build/bnfc/bnfc-tmp/LexBNF.hs @@ -0,0 +1,375 @@ +{-# LANGUAGE CPP,MagicHash #-} +{-# LINE 3 "src/LexBNF.x" #-} + +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module LexBNF where + + + +import qualified Data.Bits +import Data.Word (Word8) + +#if __GLASGOW_HASKELL__ >= 603 +#include "ghcconfig.h" +#elif defined(__GLASGOW_HASKELL__) +#include "config.h" +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +import Data.Char (ord) +import Data.Array.Base (unsafeAt) +#else +import Array +import Char (ord) +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif +alex_base :: AlexAddr +alex_base = AlexA# "\x01\x00\x00\x00\x38\x00\x00\x00\x39\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x45\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x0d\x00\x00\x00\x9c\x00\x00\x00\x6c\x01\x00\x00\x00\x00\x00\x00\x17\x01\x00\x00\xe7\x01\x00\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x29\x00\x00\x00\x9d\x00\x00\x00\xd3\x00\x00\x00\x35\x00\x00\x00\xe7\x00\x00\x00\x21\x00\x00\x00\xf2\x00\x00\x00\x1d\x01\x00\x00\xb7\x01\x00\x00"# + +alex_table :: AlexAddr +alex_table = AlexA# "\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\x0b\x00\x0b\x00\x0b\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x03\x00\x0c\x00\xff\xff\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x0d\x00\x0c\x00\xff\xff\x0c\x00\xff\xff\x0c\x00\xff\xff\xff\xff\xff\xff\x01\x00\x07\x00\x07\x00\x07\x00\x08\x00\x0e\x00\x0c\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x15\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x00\x00\x0c\x00\xff\xff\x0c\x00\xff\xff\x0c\x00\xff\xff\x0b\x00\x1c\x00\x00\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x00\x00\x00\x00\x07\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0c\x00\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x05\x00\x10\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x13\x00\xff\xff\x18\x00\x16\x00\x10\x00\x13\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\xff\xff\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x13\x00\x1e\x00\x00\x00\x1d\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x14\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\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\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x14\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x00\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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\x0a\x00\x0a\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x3a\x00\x3d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x27\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x20\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\xff\xff\xff\xff\x2d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\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\x7d\x00\x7d\x00\x27\x00\x27\x00\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\xd7\x00\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\x22\x00\xf7\x00\x5c\x00\x27\x00\x5f\x00\x27\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0a\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\x5c\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\x74\x00\x2d\x00\xff\xff\x65\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\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\x5c\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\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\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\x22\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\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\x5c\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\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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# "\x0f\x00\x02\x00\x02\x00\xff\xff\x09\x00\xff\xff\x09\x00\x09\x00\x09\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\x13\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_accept = listArray (0::Int,30) [[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[],[],[],[(AlexAcc (alex_action_6))],[],[],[],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_8))],[],[],[]] +{-# LINE 37 "src/LexBNF.x" #-} + + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String !Int -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +tokenPosn (PT p _) = p +tokenPosn (Err p) = p +tokenLineCol = posLineCol . tokenPosn +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s _) -> s + PT _ (TL s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "digit" 21 (b "=" 11 (b "-" 6 (b "*" 3 (b ")" 2 (b "(" 1 N N) N) (b "," 5 (b "+" 4 N N) N)) (b "::=" 9 (b ":" 8 (b "." 7 N N) N) (b ";" 10 N N))) (b "char" 16 (b "]" 14 (b "[" 13 (b "?" 12 N N) N) (b "_" 15 N N)) (b "define" 19 (b "comment" 18 (b "coercions" 17 N N) N) (b "delimiters" 20 N N)))) (b "separator" 31 (b "letter" 26 (b "internal" 24 (b "eps" 23 (b "entrypoints" 22 N N) N) (b "layout" 25 N N)) (b "position" 29 (b "nonempty" 28 (b "lower" 27 N N) N) (b "rules" 30 N N))) (b "upper" 36 (b "token" 34 (b "terminator" 33 (b "stop" 32 N N) N) (b "toplevel" 35 N N)) (b "|" 39 (b "{" 38 (b "views" 37 N N) N) (b "}" 40 N N)))) + where b s n = let bs = id s + in B bs (TS bs n) + +unescapeInitTail :: String -> String +unescapeInitTail = id . unesc . tail . id where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type Byte = Word8 + +type AlexInput = (Posn, -- current position, + Char, -- previous char + [Byte], -- pending bytes on the current char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', [], str) + where + go :: AlexInput -> [Token] + go inp@(pos, _, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _, _) -> [Err pos] + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) +alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s)) +alexGetByte (p, _, [], s) = + case s of + [] -> Nothing + (c:s) -> + let p' = alexMove p c + (b:bs) = utf8Encode c + in p' `seq` Just (b, (p', c, bs, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, bs, s) = c + + -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. +utf8Encode :: Char -> [Word8] +utf8Encode = map fromIntegral . go . ord + where + go oc + | oc <= 0x7f = [oc] + + | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6) + , 0x80 + oc Data.Bits..&. 0x3f + ] + + | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12) + , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) + , 0x80 + oc Data.Bits..&. 0x3f + ] + | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18) + , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f) + , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) + , 0x80 + oc Data.Bits..&. 0x3f + ] + +alex_action_3 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_4 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_5 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) +alex_action_6 = tok (\p s -> PT p (TC $ share s)) +alex_action_7 = tok (\p s -> PT p (TI $ share s)) +alex_action_8 = tok (\p s -> PT p (TD $ share s)) +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +{-# LINE 37 "templates/GenericTemplate.hs" #-} + +{-# LINE 47 "templates/GenericTemplate.hs" #-} + + +data AlexAddr = AlexA# Addr# + +#if __GLASGOW_HASKELL__ < 503 +uncheckedShiftL# = shiftL# +#endif + +{-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow16Int# i + where + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# +#else + indexInt16OffAddr# arr off +#endif + + + + + +{-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow32Int# i + where + i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + (b2 `uncheckedShiftL#` 16#) `or#` + (b1 `uncheckedShiftL#` 8#) `or#` b0) + b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) + b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) + b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + b0 = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 4# +#else + indexInt32OffAddr# arr off +#endif + + + + + +#if __GLASGOW_HASKELL__ < 503 +quickIndex arr i = arr ! i +#else +-- GHC >= 503, unsafeAt is available from Data.Array.Base. +quickIndex = unsafeAt +#endif + + + + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> AlexReturn a +alexScan input (I# (sc)) + = alexScanUser undefined input (I# (sc)) + +alexScanUser user input (I# (sc)) + = case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, input') -> + case alexGetChar 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 alexGetChar input of + Nothing -> (new_acc, input) + Just (c, new_input) -> + + + + let + (base) = alexIndexInt32OffAddr alex_base s + ((I# (ord_c))) = ord c + (offset) = (base +# ord_c) + (check) = alexIndexInt16OffAddr alex_check offset + + (new_s) = if (offset >=# 0#) && (check ==# ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + case new_s of + -1# -> (new_acc, input) + -- on an error, we want to keep the input *before* the + -- character that failed, not after. + _ -> alex_scan_tkn user orig_input (len +# 1#) + new_input new_s new_acc + + where + check_accs [] = last_acc + check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) + check_accs (AlexAccPred a predx : rest) + | predx user orig_input (I# (len)) input + = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkipPred predx : rest) + | predx user orig_input (I# (len)) input + = AlexLastSkip input (I# (len)) + check_accs (_ : rest) = check_accs rest + +data AlexLastAcc a + = AlexNone + | AlexLastAcc a !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc a user + = AlexAcc a + | AlexAccSkip + | AlexAccPred a (AlexAccPred user) + | AlexAccSkipPred (AlexAccPred user) + +type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool + +-- ----------------------------------------------------------------------------- +-- Predicates on a rule + +alexAndPred p1 p2 user in1 len in2 + = p1 user in1 len in2 && p2 user in1 len in2 + +--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input + +--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input + +--alexRightContext :: Int -> AlexAccPred _ +alexRightContext (I# (sc)) user _ _ input = + case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, _) -> False + _ -> True + -- TODO: there's no need to find the longest + -- match when checking the right context, just + -- the first match will do. + +-- used by wrappers +iUnbox (I# (i)) = i diff --git a/dist/build/bnfc/bnfc-tmp/ParBNF.hs b/dist/build/bnfc/bnfc-tmp/ParBNF.hs new file mode 100644 --- /dev/null +++ b/dist/build/bnfc/bnfc-tmp/ParBNF.hs @@ -0,0 +1,1703 @@ +{-# OPTIONS_GHC -w #-} +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module ParBNF where +import AbsBNF +import LexBNF +import ErrM +import qualified Data.Array as Happy_Data_Array +import qualified GHC.Exts as Happy_GHC_Exts + +-- parser produced by Happy Version 1.18.6 + +newtype HappyAbsSyn = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +happyIn36 :: (String) -> (HappyAbsSyn ) +happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn ) -> (String) +happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut36 #-} +happyIn37 :: (Ident) -> (HappyAbsSyn ) +happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn ) -> (Ident) +happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut37 #-} +happyIn38 :: (Integer) -> (HappyAbsSyn ) +happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn ) -> (Integer) +happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut38 #-} +happyIn39 :: (Char) -> (HappyAbsSyn ) +happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn ) -> (Char) +happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut39 #-} +happyIn40 :: (Double) -> (HappyAbsSyn ) +happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn ) -> (Double) +happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut40 #-} +happyIn41 :: (LGrammar) -> (HappyAbsSyn ) +happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn ) -> (LGrammar) +happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut41 #-} +happyIn42 :: (LDef) -> (HappyAbsSyn ) +happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn42 #-} +happyOut42 :: (HappyAbsSyn ) -> (LDef) +happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut42 #-} +happyIn43 :: ([LDef]) -> (HappyAbsSyn ) +happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn ) -> ([LDef]) +happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut43 #-} +happyIn44 :: (Grammar) -> (HappyAbsSyn ) +happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn ) -> (Grammar) +happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut44 #-} +happyIn45 :: ([Def]) -> (HappyAbsSyn ) +happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn ) -> ([Def]) +happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut45 #-} +happyIn46 :: ([Item]) -> (HappyAbsSyn ) +happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn ) -> ([Item]) +happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut46 #-} +happyIn47 :: (Def) -> (HappyAbsSyn ) +happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn47 #-} +happyOut47 :: (HappyAbsSyn ) -> (Def) +happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut47 #-} +happyIn48 :: (Item) -> (HappyAbsSyn ) +happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn48 #-} +happyOut48 :: (HappyAbsSyn ) -> (Item) +happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut48 #-} +happyIn49 :: (Cat) -> (HappyAbsSyn ) +happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn49 #-} +happyOut49 :: (HappyAbsSyn ) -> (Cat) +happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut49 #-} +happyIn50 :: (Label) -> (HappyAbsSyn ) +happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn50 #-} +happyOut50 :: (HappyAbsSyn ) -> (Label) +happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut50 #-} +happyIn51 :: (LabelId) -> (HappyAbsSyn ) +happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn51 #-} +happyOut51 :: (HappyAbsSyn ) -> (LabelId) +happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut51 #-} +happyIn52 :: (ProfItem) -> (HappyAbsSyn ) +happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn52 #-} +happyOut52 :: (HappyAbsSyn ) -> (ProfItem) +happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut52 #-} +happyIn53 :: (IntList) -> (HappyAbsSyn ) +happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn53 #-} +happyOut53 :: (HappyAbsSyn ) -> (IntList) +happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut53 #-} +happyIn54 :: ([Integer]) -> (HappyAbsSyn ) +happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn54 #-} +happyOut54 :: (HappyAbsSyn ) -> ([Integer]) +happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut54 #-} +happyIn55 :: ([IntList]) -> (HappyAbsSyn ) +happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn55 #-} +happyOut55 :: (HappyAbsSyn ) -> ([IntList]) +happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut55 #-} +happyIn56 :: ([ProfItem]) -> (HappyAbsSyn ) +happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn56 #-} +happyOut56 :: (HappyAbsSyn ) -> ([ProfItem]) +happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut56 #-} +happyIn57 :: (Separation) -> (HappyAbsSyn ) +happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn57 #-} +happyOut57 :: (HappyAbsSyn ) -> (Separation) +happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut57 #-} +happyIn58 :: (Arg) -> (HappyAbsSyn ) +happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn58 #-} +happyOut58 :: (HappyAbsSyn ) -> (Arg) +happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut58 #-} +happyIn59 :: ([Arg]) -> (HappyAbsSyn ) +happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn59 #-} +happyOut59 :: (HappyAbsSyn ) -> ([Arg]) +happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut59 #-} +happyIn60 :: (Exp) -> (HappyAbsSyn ) +happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn60 #-} +happyOut60 :: (HappyAbsSyn ) -> (Exp) +happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut60 #-} +happyIn61 :: (Exp) -> (HappyAbsSyn ) +happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn61 #-} +happyOut61 :: (HappyAbsSyn ) -> (Exp) +happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut61 #-} +happyIn62 :: (Exp) -> (HappyAbsSyn ) +happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn62 #-} +happyOut62 :: (HappyAbsSyn ) -> (Exp) +happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut62 #-} +happyIn63 :: ([Exp]) -> (HappyAbsSyn ) +happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn63 #-} +happyOut63 :: (HappyAbsSyn ) -> ([Exp]) +happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut63 #-} +happyIn64 :: ([Exp]) -> (HappyAbsSyn ) +happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn64 #-} +happyOut64 :: (HappyAbsSyn ) -> ([Exp]) +happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut64 #-} +happyIn65 :: ([String]) -> (HappyAbsSyn ) +happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn65 #-} +happyOut65 :: (HappyAbsSyn ) -> ([String]) +happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut65 #-} +happyIn66 :: ([RHS]) -> (HappyAbsSyn ) +happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn66 #-} +happyOut66 :: (HappyAbsSyn ) -> ([RHS]) +happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut66 #-} +happyIn67 :: (RHS) -> (HappyAbsSyn ) +happyIn67 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn67 #-} +happyOut67 :: (HappyAbsSyn ) -> (RHS) +happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut67 #-} +happyIn68 :: (MinimumSize) -> (HappyAbsSyn ) +happyIn68 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn68 #-} +happyOut68 :: (HappyAbsSyn ) -> (MinimumSize) +happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut68 #-} +happyIn69 :: (Reg) -> (HappyAbsSyn ) +happyIn69 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn69 #-} +happyOut69 :: (HappyAbsSyn ) -> (Reg) +happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut69 #-} +happyIn70 :: (Reg) -> (HappyAbsSyn ) +happyIn70 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn70 #-} +happyOut70 :: (HappyAbsSyn ) -> (Reg) +happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut70 #-} +happyIn71 :: (Reg) -> (HappyAbsSyn ) +happyIn71 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn71 #-} +happyOut71 :: (HappyAbsSyn ) -> (Reg) +happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut71 #-} +happyIn72 :: (Reg) -> (HappyAbsSyn ) +happyIn72 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn72 #-} +happyOut72 :: (HappyAbsSyn ) -> (Reg) +happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut72 #-} +happyIn73 :: ([Ident]) -> (HappyAbsSyn ) +happyIn73 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn73 #-} +happyOut73 :: (HappyAbsSyn ) -> ([Ident]) +happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut73 #-} +happyInTok :: (Token) -> (HappyAbsSyn ) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> (Token) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x62\x00\x62\x00\x62\x00\x7c\x00\x7c\x00\x00\x00\x7c\x00\x5c\x00\x89\x00\x3d\x00\x3d\x00\xdd\x01\xd7\x01\xdc\x01\xd3\x01\xdb\x01\xbe\x00\xda\x01\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\xd9\x01\x00\x00\x00\x00\xd8\x01\x46\x00\x46\x00\x46\x00\x46\x00\xd6\x01\xd4\x01\x00\x00\xd5\x01\xd2\x01\x00\x00\x00\x00\x36\x00\xd1\x01\x8d\x01\xcf\x01\x46\x00\xce\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x01\x00\x00\x07\x00\xe1\xff\x01\x00\xcd\x01\x00\x00\x5c\x00\xcd\x01\xcd\x01\xcb\x01\xd0\x01\xca\x01\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\xc9\x01\xcc\x01\x00\x00\xc6\x01\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x08\x00\xc6\x01\xc6\x01\xc6\x01\xc6\x01\xfe\x00\x00\x00\xc6\x01\xc6\x01\xc7\x01\xc7\x01\xc8\x01\xc4\x01\xc5\x01\xc3\x01\xc0\x01\xc2\x01\xc1\x01\xbc\x01\xbc\x01\xbc\x01\x00\x00\xbc\x01\xbf\x01\xbd\x01\x00\x00\xb9\x01\x1f\x00\x00\x00\xb9\x01\x89\x00\x00\x00\xb9\x01\x00\x00\xb9\x01\xbe\x01\xbb\x01\xba\x01\xb8\x01\x89\x00\xb8\x01\x05\x00\x6f\x01\xae\x01\xb5\x01\xb7\x01\xb7\x01\xb3\x01\xf4\xff\xac\x01\xb6\x01\xaa\x01\x00\x00\x50\x00\xb2\x01\xa9\x01\x00\x00\xb1\x01\xa7\x01\x9b\x01\x9b\x01\x00\x00\x00\x00\x7c\x00\x62\x00\x9a\x01\x7c\x00\x00\x00\x46\x00\x89\x00\x89\x00\xaf\x01\x99\x01\x00\x00\x98\x01\x00\x00\xb0\x01\x00\x00\x96\x01\x00\x00\x96\x01\x92\x01\x89\x00\xa8\x01\xb4\x01\x00\x00\x64\x01\x00\x00\x9a\x00\x90\x01\xa4\x01\xa6\x01\xa6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x01\xad\x01\x08\x00\x08\x00\x00\x00\x8b\x01\x00\x00\x26\x01\x46\x00\x00\x00\x00\x00\x00\x00\x88\x01\xa0\x01\xab\x01\x46\x00\x46\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x01\x00\x00\x00\x00\xa2\x01\x00\x00\x00\x00\xf8\xff\x80\x01\x89\x00\x00\x00\x46\x00\x00\x00\x80\x01\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x01\xbe\x00\x08\x00\x00\x00\xa5\x01\xa1\x01\x97\x01\x00\x00\x5c\x00\x00\x00\x86\x01\x00\x00\x5c\x00\x00\x00\x7a\x01\x95\x01\x9d\x01\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x9e\x00\xbb\x00\xb9\x00\x65\x01\x75\x01\x93\x01\x77\x01\x89\x01\x7e\x01\x79\x01\xcc\x00\x91\x01\x8f\x01\xa0\x00\xe5\x00\x8a\x01\x87\x01\x92\x00\x84\x01\x3b\x01\x40\x01\x45\x01\x11\x01\xeb\x00\x91\x00\x44\x01\x78\x00\x6d\x01\x5b\x00\x17\x00\x42\x00\xb6\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x94\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x01\x00\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x4f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x01\xe6\x00\x00\x00\x00\x00\x00\x00\xf0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x8c\x01\x7b\x01\x83\x01\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x74\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x01\x68\x01\x57\x01\x51\x01\x06\x00\xbd\x00\x6d\x00\x00\x00\x56\x01\x17\x01\xe9\x00\x05\x01\x4f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\xa9\x00\x03\x00\x6e\x01\x00\x00\xae\x00\x24\x01\xfb\x00\x00\x00\x9f\x00\x00\x00\x4e\x00\x00\x00\x00\x00\x00\x00\xf7\x00\xc5\x00\xab\x00\xc3\x00\xf4\x00\x00\x00\x3d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\xaa\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x01\xe1\x00\x00\x00\x0d\x00\x42\x01\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x21\x00\x00\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\xa1\x00\xb5\x00\x00\x00\x1e\x00\x2c\x01\x57\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x16\x01\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x01\x00\x00\xef\xff\x02\x00\x4f\x01\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xd5\xff\x00\x00\xd5\xff\xd1\xff\xd1\xff\xce\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\xff\xaa\xff\x00\x00\xa5\xff\x00\x00\xa1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x92\xff\x00\x00\xce\xff\xce\xff\x89\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\xff\x75\xff\x00\x00\xdd\xff\x7f\xff\x84\xff\x76\xff\x87\xff\x00\x00\x00\x00\x00\x00\x78\xff\x7c\xff\x80\xff\x7b\xff\x79\xff\x7a\xff\x00\x00\xdb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x8a\xff\x8b\xff\x00\x00\x00\x00\x8d\xff\x8f\xff\x00\x00\x98\xff\x9b\xff\x9a\xff\x99\xff\x97\xff\x91\xff\x9e\xff\x9c\xff\x00\x00\x00\x00\x92\xff\xdc\xff\xda\xff\x9b\xff\x94\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa7\xff\x00\x00\x00\x00\xa9\xff\x00\x00\xad\xff\xac\xff\x00\x00\x00\x00\x00\x00\xb4\xff\x00\x00\x00\x00\x00\x00\xb3\xff\x00\x00\xb8\xff\xb9\xff\x00\x00\x00\x00\xbc\xff\x00\x00\xbb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\xff\x89\xff\x00\x00\x00\x00\x00\x00\xd0\xff\x00\x00\xd2\xff\xb4\xff\xd4\xff\x00\x00\xd8\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\xd6\xff\x00\x00\xd5\xff\x00\x00\xd1\xff\xcd\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\xff\x00\x00\xbd\xff\x00\x00\xc6\xff\x00\x00\xa1\xff\xcb\xff\x00\x00\x00\x00\x00\x00\xb5\xff\xb7\xff\x00\x00\xb2\xff\x00\x00\xad\xff\x00\x00\xaa\xff\xaa\xff\xa6\xff\xa4\xff\xa3\xff\xa0\xff\x93\xff\x00\x00\x00\x00\x00\x00\x92\xff\x9d\xff\x00\x00\xce\xff\x88\xff\x00\x00\x83\xff\x82\xff\x81\xff\x00\x00\x00\x00\x00\x00\x00\x00\x85\xff\x77\xff\x7e\xff\x7d\xff\x86\xff\x8c\xff\x8e\xff\x90\xff\x9f\xff\x95\xff\x96\xff\x00\x00\xa8\xff\xae\xff\xab\xff\xb1\xff\x00\x00\xb6\xff\xba\xff\x00\x00\xc2\xff\xca\xff\x00\x00\x00\x00\x00\x00\xbe\xff\x00\x00\xce\xff\x00\x00\x00\x00\xc8\xff\xcf\xff\x74\xff\xd3\xff\xd7\xff\xc4\xff\xc5\xff\xc1\xff\xc7\xff\x00\x00\xa5\xff\x00\x00\xce\xff\x00\x00\x00\x00\x00\x00\xb0\xff\xcc\xff\xc0\xff\x89\xff\xce\xff\xc9\xff\xc3\xff\xad\xff\x00\x00\x00\x00\xaf\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x0d\x00\x01\x00\x0b\x00\x01\x00\x01\x00\x01\x00\x01\x00\x27\x00\x01\x00\x03\x00\x04\x00\x0a\x00\x00\x00\x0d\x00\x20\x00\x2f\x00\x10\x00\x0d\x00\x0c\x00\x0f\x00\x0d\x00\x15\x00\x01\x00\x17\x00\x0a\x00\x03\x00\x1a\x00\x1b\x00\x29\x00\x2a\x00\x15\x00\x01\x00\x03\x00\x2a\x00\x2f\x00\x03\x00\x24\x00\x00\x00\x26\x00\x25\x00\x25\x00\x1d\x00\x25\x00\x0d\x00\x2c\x00\x0f\x00\x2a\x00\x2f\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2f\x00\x01\x00\x21\x00\x22\x00\x23\x00\x25\x00\x06\x00\x01\x00\x01\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0d\x00\x23\x00\x03\x00\x10\x00\x01\x00\x03\x00\x2a\x00\x0d\x00\x15\x00\x0f\x00\x17\x00\x00\x00\x02\x00\x1a\x00\x1b\x00\x16\x00\x0d\x00\x02\x00\x05\x00\x10\x00\x00\x00\x08\x00\x03\x00\x24\x00\x15\x00\x26\x00\x17\x00\x03\x00\x12\x00\x1a\x00\x1b\x00\x2c\x00\x01\x00\x12\x00\x23\x00\x21\x00\x2a\x00\x23\x00\x0d\x00\x24\x00\x1d\x00\x26\x00\x00\x00\x11\x00\x0d\x00\x13\x00\x0f\x00\x2c\x00\x11\x00\x12\x00\x13\x00\x14\x00\x21\x00\x16\x00\x23\x00\x18\x00\x19\x00\x21\x00\x01\x00\x23\x00\x1d\x00\x1e\x00\x1f\x00\x0a\x00\x21\x00\x22\x00\x29\x00\x2a\x00\x25\x00\x02\x00\x0d\x00\x1d\x00\x0f\x00\x2a\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x16\x00\x01\x00\x18\x00\x19\x00\x0d\x00\x1f\x00\x12\x00\x1d\x00\x1e\x00\x1f\x00\x02\x00\x21\x00\x22\x00\x01\x00\x01\x00\x00\x00\x02\x00\x05\x00\x06\x00\x07\x00\x2a\x00\x0d\x00\x16\x00\x0b\x00\x01\x00\x00\x00\x0e\x00\x0f\x00\x1d\x00\x06\x00\x07\x00\x03\x00\x12\x00\x2a\x00\x0b\x00\x03\x00\x01\x00\x0e\x00\x0f\x00\x03\x00\x01\x00\x11\x00\x01\x00\x13\x00\x01\x00\x06\x00\x07\x00\x06\x00\x0d\x00\x25\x00\x0b\x00\x02\x00\x0b\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x01\x00\x25\x00\x21\x00\x22\x00\x23\x00\x24\x00\x21\x00\x22\x00\x23\x00\x24\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0f\x00\x17\x00\x1f\x00\x25\x00\x21\x00\x25\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x01\x00\x11\x00\x00\x00\x13\x00\x18\x00\x19\x00\x1a\x00\x01\x00\x1c\x00\x18\x00\x19\x00\x1a\x00\x0d\x00\x1c\x00\x18\x00\x19\x00\x1a\x00\x01\x00\x1c\x00\x0d\x00\x20\x00\x1a\x00\x1b\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x01\x00\x1a\x00\x1b\x00\x2a\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x2f\x00\x18\x00\x19\x00\x1a\x00\x0d\x00\x0c\x00\x18\x00\x19\x00\x1a\x00\x0a\x00\x20\x00\x18\x00\x19\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1e\x00\x1f\x00\x0a\x00\x10\x00\x0a\x00\x00\x00\x01\x00\x14\x00\x01\x00\x18\x00\x19\x00\x1a\x00\x01\x00\x01\x00\x01\x00\x19\x00\x1a\x00\x0c\x00\x0d\x00\x01\x00\x0d\x00\x1a\x00\x1e\x00\x1f\x00\x1e\x00\x1f\x00\x0f\x00\x10\x00\x01\x00\x0b\x00\x00\x00\x14\x00\x0e\x00\x0f\x00\x08\x00\x08\x00\x09\x00\x01\x00\x0b\x00\x0d\x00\x01\x00\x0e\x00\x0f\x00\x01\x00\x01\x00\x09\x00\x01\x00\x0b\x00\x01\x00\x00\x00\x0e\x00\x0f\x00\x09\x00\x01\x00\x0b\x00\x0d\x00\x0b\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x0e\x00\x0f\x00\x00\x00\x01\x00\x0d\x00\x00\x00\x20\x00\x00\x00\x20\x00\x03\x00\x04\x00\x23\x00\x10\x00\x00\x00\x0c\x00\x0d\x00\x14\x00\x29\x00\x0c\x00\x10\x00\x17\x00\x15\x00\x0a\x00\x14\x00\x02\x00\x11\x00\x10\x00\x1c\x00\x0e\x00\x0d\x00\x2b\x00\x05\x00\x02\x00\x09\x00\x29\x00\x0e\x00\x09\x00\x0e\x00\x02\x00\x0e\x00\x02\x00\x28\x00\x0e\x00\x0e\x00\x0d\x00\x29\x00\x01\x00\x0e\x00\x07\x00\x09\x00\x08\x00\xff\xff\x2b\x00\x0a\x00\x2b\x00\xff\xff\x29\x00\x0a\x00\x29\x00\xff\xff\x2a\x00\x2a\x00\x07\x00\x05\x00\x08\x00\x05\x00\x01\x00\x2f\x00\x0e\x00\xff\xff\xff\xff\x05\x00\xff\xff\x22\x00\x2a\x00\x0d\x00\x1c\x00\x08\x00\x05\x00\xff\xff\xff\xff\x2f\x00\x2f\x00\x05\x00\x2f\x00\x01\x00\x2a\x00\x01\x00\x2a\x00\x0d\x00\xff\xff\x2a\x00\x29\x00\x0d\x00\x2a\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x2b\x00\xff\xff\x2f\x00\x29\x00\xff\xff\x27\x00\x2f\x00\x1c\x00\x2f\x00\xff\xff\x29\x00\x27\x00\x2f\x00\xff\xff\xff\xff\x2f\x00\x29\x00\x2f\x00\xff\xff\x2a\x00\x2f\x00\x29\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x6d\x00\x2c\x00\xea\x00\x23\x00\x23\x00\x66\x00\x23\x00\xb9\x00\x4a\x00\xba\x00\xbb\x00\xf3\x00\x3e\x00\x2d\x00\xf4\x00\xff\xff\x2e\x00\x67\x00\xbc\x00\x68\x00\x4b\x00\x2f\x00\x23\x00\x30\x00\xef\x00\x26\x00\x31\x00\x32\x00\x23\x00\x26\x00\xf1\x00\xa5\x00\x26\x00\x26\x00\xff\xff\x26\x00\x33\x00\xe3\x00\x34\x00\xe0\x00\x8c\x00\xc6\x00\x9b\x00\x67\x00\x35\x00\x68\x00\x26\x00\xff\xff\x23\x00\x26\x00\x4c\x00\x35\x00\x4d\x00\xff\xff\x2c\x00\x27\x00\x36\x00\x29\x00\x24\x00\xc0\x00\x54\x00\x66\x00\x27\x00\x28\x00\x29\x00\xe6\x00\x2d\x00\xb7\x00\x26\x00\x2e\x00\x2c\x00\x26\x00\x26\x00\x67\x00\x2f\x00\x68\x00\x30\x00\x3e\x00\x5f\x00\x31\x00\x32\x00\xae\x00\x2d\x00\x5f\x00\x90\x00\x2e\x00\xe4\x00\x75\xff\x26\x00\x33\x00\x2f\x00\x34\x00\x30\x00\x26\x00\xf6\x00\x31\x00\x32\x00\x35\x00\x66\x00\xce\x00\x35\x00\xc0\x00\x26\x00\x29\x00\x6d\x00\x33\x00\xd9\x00\x34\x00\x3e\x00\x5c\x00\x67\x00\xcb\x00\x68\x00\x35\x00\x73\x00\x74\x00\x75\x00\x76\x00\xc4\x00\x77\x00\x29\x00\x78\x00\x79\x00\x37\x00\x66\x00\x29\x00\x7a\x00\x7b\x00\x7c\x00\x3a\x00\x7d\x00\x7e\x00\x23\x00\x26\x00\x89\x00\x5f\x00\x67\x00\x97\x00\x68\x00\x26\x00\x73\x00\x74\x00\x75\x00\x76\x00\x3e\x00\x77\x00\x54\x00\x78\x00\x79\x00\x6d\x00\x3b\x00\xa8\x00\x7a\x00\x7b\x00\x7c\x00\xd0\x00\x7d\x00\x7e\x00\x83\x00\xda\x00\xe8\x00\x5f\x00\x8a\x00\x84\x00\x8b\x00\x26\x00\xd1\x00\x55\x00\x86\x00\x83\x00\xd5\x00\x71\x00\x69\x00\x3f\x00\x84\x00\xe1\x00\x26\x00\x60\x00\x26\x00\x86\x00\x26\x00\x6a\x00\x71\x00\x69\x00\x26\x00\x83\x00\x5c\x00\x83\x00\xcc\x00\x63\x00\x84\x00\x85\x00\x89\x00\xe7\x00\x87\x00\x86\x00\xd4\x00\x86\x00\x71\x00\x69\x00\x71\x00\x69\x00\x9a\x00\x69\x00\x63\x00\x87\x00\x27\x00\x28\x00\x29\x00\xde\x00\x27\x00\x28\x00\x29\x00\xbe\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x64\x00\xd6\x00\x58\x00\x87\x00\x59\x00\x87\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x6a\x00\x5c\x00\xd7\x00\x5d\x00\x45\x00\x46\x00\x47\x00\x6a\x00\xc7\x00\x45\x00\x46\x00\x47\x00\xd3\x00\xb0\x00\x45\x00\x46\x00\x47\x00\x92\x00\x48\x00\xdc\x00\x93\x00\x4e\x00\xaf\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x6a\x00\x4e\x00\xb4\x00\x26\x00\xba\x00\xbb\x00\x4e\x00\x4f\x00\xff\xff\xf0\x00\x46\x00\x47\x00\xdd\x00\xbc\x00\xc8\x00\x46\x00\x47\x00\x3a\x00\x94\x00\xb1\x00\x46\x00\x47\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x40\x00\x4d\x00\x42\x00\x43\x00\x44\x00\xe5\x00\x3d\x00\x3a\x00\x59\x00\x3a\x00\x6d\x00\x6a\x00\xd1\x00\x6a\x00\x52\x00\x46\x00\x47\x00\x63\x00\x95\x00\x9d\x00\x51\x00\x47\x00\x91\x00\x6f\x00\x63\x00\x9c\x00\x50\x00\xc5\x00\x3d\x00\x3c\x00\x3d\x00\xa2\x00\x59\x00\x63\x00\xe2\x00\x9e\x00\xa3\x00\x71\x00\x69\x00\xa7\x00\x81\x00\x82\x00\x63\x00\x80\x00\xab\x00\x9f\x00\x71\x00\x69\x00\x6a\x00\x63\x00\xdf\x00\x63\x00\x80\x00\x63\x00\xac\x00\x71\x00\x69\x00\x7f\x00\x6a\x00\x80\x00\xa1\x00\x70\x00\x71\x00\x69\x00\x71\x00\x69\x00\x68\x00\x69\x00\x6d\x00\x6a\x00\x6b\x00\xad\x00\x38\x00\xbc\x00\x99\x00\xba\x00\xbb\x00\x9a\x00\x59\x00\xbd\x00\x6e\x00\x6f\x00\xab\x00\x23\x00\xbc\x00\x59\x00\x53\x00\x56\x00\x7e\x00\x5a\x00\xf9\x00\x61\x00\x62\x00\x3a\x00\xf8\x00\xf6\x00\x4c\x00\xee\x00\xef\x00\xf3\x00\x23\x00\xec\x00\xeb\x00\xed\x00\xc2\x00\xc3\x00\xca\x00\xc4\x00\xcb\x00\xce\x00\x5f\x00\x23\x00\x5c\x00\xd3\x00\xd9\x00\xdc\x00\x8e\x00\x00\x00\x4c\x00\x8f\x00\x4c\x00\x00\x00\x23\x00\x91\x00\x23\x00\x00\x00\x26\x00\x26\x00\xa1\x00\xa8\x00\xa7\x00\xaa\x00\x5c\x00\xff\xff\xa6\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x97\x00\x26\x00\xab\x00\x3a\x00\xb3\x00\xb6\x00\x00\x00\x00\x00\xff\xff\xff\xff\x90\x00\xff\xff\x5c\x00\x26\x00\x5c\x00\x26\x00\x5f\x00\x00\x00\x26\x00\x23\x00\x5f\x00\x26\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x4c\x00\x00\x00\xff\xff\x23\x00\x00\x00\xb7\x00\xff\xff\x3a\x00\xff\xff\x00\x00\x23\x00\xb9\x00\xff\xff\x00\x00\x00\x00\xff\xff\x23\x00\xff\xff\x00\x00\x26\x00\xff\xff\x23\x00\x00\x00\x26\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = Happy_Data_Array.array (33, 139) [ + (33 , happyReduce_33), + (34 , happyReduce_34), + (35 , happyReduce_35), + (36 , happyReduce_36), + (37 , happyReduce_37), + (38 , happyReduce_38), + (39 , happyReduce_39), + (40 , happyReduce_40), + (41 , happyReduce_41), + (42 , happyReduce_42), + (43 , happyReduce_43), + (44 , happyReduce_44), + (45 , happyReduce_45), + (46 , happyReduce_46), + (47 , happyReduce_47), + (48 , happyReduce_48), + (49 , happyReduce_49), + (50 , happyReduce_50), + (51 , happyReduce_51), + (52 , happyReduce_52), + (53 , happyReduce_53), + (54 , happyReduce_54), + (55 , happyReduce_55), + (56 , happyReduce_56), + (57 , happyReduce_57), + (58 , happyReduce_58), + (59 , happyReduce_59), + (60 , happyReduce_60), + (61 , happyReduce_61), + (62 , happyReduce_62), + (63 , happyReduce_63), + (64 , happyReduce_64), + (65 , happyReduce_65), + (66 , happyReduce_66), + (67 , happyReduce_67), + (68 , happyReduce_68), + (69 , happyReduce_69), + (70 , happyReduce_70), + (71 , happyReduce_71), + (72 , happyReduce_72), + (73 , happyReduce_73), + (74 , happyReduce_74), + (75 , happyReduce_75), + (76 , happyReduce_76), + (77 , happyReduce_77), + (78 , happyReduce_78), + (79 , happyReduce_79), + (80 , happyReduce_80), + (81 , happyReduce_81), + (82 , happyReduce_82), + (83 , happyReduce_83), + (84 , happyReduce_84), + (85 , happyReduce_85), + (86 , happyReduce_86), + (87 , happyReduce_87), + (88 , happyReduce_88), + (89 , happyReduce_89), + (90 , happyReduce_90), + (91 , happyReduce_91), + (92 , happyReduce_92), + (93 , happyReduce_93), + (94 , happyReduce_94), + (95 , happyReduce_95), + (96 , happyReduce_96), + (97 , happyReduce_97), + (98 , happyReduce_98), + (99 , happyReduce_99), + (100 , happyReduce_100), + (101 , happyReduce_101), + (102 , happyReduce_102), + (103 , happyReduce_103), + (104 , happyReduce_104), + (105 , happyReduce_105), + (106 , happyReduce_106), + (107 , happyReduce_107), + (108 , happyReduce_108), + (109 , happyReduce_109), + (110 , happyReduce_110), + (111 , happyReduce_111), + (112 , happyReduce_112), + (113 , happyReduce_113), + (114 , happyReduce_114), + (115 , happyReduce_115), + (116 , happyReduce_116), + (117 , happyReduce_117), + (118 , happyReduce_118), + (119 , happyReduce_119), + (120 , happyReduce_120), + (121 , happyReduce_121), + (122 , happyReduce_122), + (123 , happyReduce_123), + (124 , happyReduce_124), + (125 , happyReduce_125), + (126 , happyReduce_126), + (127 , happyReduce_127), + (128 , happyReduce_128), + (129 , happyReduce_129), + (130 , happyReduce_130), + (131 , happyReduce_131), + (132 , happyReduce_132), + (133 , happyReduce_133), + (134 , happyReduce_134), + (135 , happyReduce_135), + (136 , happyReduce_136), + (137 , happyReduce_137), + (138 , happyReduce_138), + (139 , happyReduce_139) + ] + +happy_n_terms = 48 :: Int +happy_n_nonterms = 38 :: Int + +happyReduce_33 = happySpecReduce_1 0# happyReduction_33 +happyReduction_33 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> + happyIn36 + (happy_var_1 + )} + +happyReduce_34 = happySpecReduce_1 1# happyReduction_34 +happyReduction_34 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) -> + happyIn37 + (Ident happy_var_1 + )} + +happyReduce_35 = happySpecReduce_1 2# happyReduction_35 +happyReduction_35 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> + happyIn38 + ((read ( happy_var_1)) :: Integer + )} + +happyReduce_36 = happySpecReduce_1 3# happyReduction_36 +happyReduction_36 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TC happy_var_1)) -> + happyIn39 + ((read ( happy_var_1)) :: Char + )} + +happyReduce_37 = happySpecReduce_1 4# happyReduction_37 +happyReduction_37 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> + happyIn40 + ((read ( happy_var_1)) :: Double + )} + +happyReduce_38 = happySpecReduce_1 5# happyReduction_38 +happyReduction_38 happy_x_1 + = case happyOut43 happy_x_1 of { happy_var_1 -> + happyIn41 + (LGr happy_var_1 + )} + +happyReduce_39 = happySpecReduce_1 6# happyReduction_39 +happyReduction_39 happy_x_1 + = case happyOut47 happy_x_1 of { happy_var_1 -> + happyIn42 + (DefAll happy_var_1 + )} + +happyReduce_40 = happySpecReduce_3 6# happyReduction_40 +happyReduction_40 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut73 happy_x_1 of { happy_var_1 -> + case happyOut47 happy_x_3 of { happy_var_3 -> + happyIn42 + (DefSome happy_var_1 happy_var_3 + )}} + +happyReduce_41 = happySpecReduce_2 6# happyReduction_41 +happyReduction_41 happy_x_2 + happy_x_1 + = case happyOut73 happy_x_2 of { happy_var_2 -> + happyIn42 + (LDefView happy_var_2 + )} + +happyReduce_42 = happySpecReduce_0 7# happyReduction_42 +happyReduction_42 = happyIn43 + ([] + ) + +happyReduce_43 = happySpecReduce_1 7# happyReduction_43 +happyReduction_43 happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + happyIn43 + ((:[]) happy_var_1 + )} + +happyReduce_44 = happySpecReduce_3 7# happyReduction_44 +happyReduction_44 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_3 of { happy_var_3 -> + happyIn43 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_45 = happySpecReduce_1 8# happyReduction_45 +happyReduction_45 happy_x_1 + = case happyOut45 happy_x_1 of { happy_var_1 -> + happyIn44 + (Grammar happy_var_1 + )} + +happyReduce_46 = happySpecReduce_0 9# happyReduction_46 +happyReduction_46 = happyIn45 + ([] + ) + +happyReduce_47 = happySpecReduce_1 9# happyReduction_47 +happyReduction_47 happy_x_1 + = case happyOut47 happy_x_1 of { happy_var_1 -> + happyIn45 + ((:[]) happy_var_1 + )} + +happyReduce_48 = happySpecReduce_3 9# happyReduction_48 +happyReduction_48 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut47 happy_x_1 of { happy_var_1 -> + case happyOut45 happy_x_3 of { happy_var_3 -> + happyIn45 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_49 = happySpecReduce_0 10# happyReduction_49 +happyReduction_49 = happyIn46 + ([] + ) + +happyReduce_50 = happySpecReduce_2 10# happyReduction_50 +happyReduction_50 happy_x_2 + happy_x_1 + = case happyOut46 happy_x_1 of { happy_var_1 -> + case happyOut48 happy_x_2 of { happy_var_2 -> + happyIn46 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_51 = happyReduce 5# 11# happyReduction_51 +happyReduction_51 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut50 happy_x_1 of { happy_var_1 -> + case happyOut49 happy_x_3 of { happy_var_3 -> + case happyOut46 happy_x_5 of { happy_var_5 -> + happyIn47 + (Rule happy_var_1 happy_var_3 (reverse happy_var_5) + ) `HappyStk` happyRest}}} + +happyReduce_52 = happySpecReduce_2 11# happyReduction_52 +happyReduction_52 happy_x_2 + happy_x_1 + = case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn47 + (Comment happy_var_2 + )} + +happyReduce_53 = happySpecReduce_3 11# happyReduction_53 +happyReduction_53 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut36 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn47 + (Comments happy_var_2 happy_var_3 + )}} + +happyReduce_54 = happyReduce 6# 11# happyReduction_54 +happyReduction_54 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut50 happy_x_2 of { happy_var_2 -> + case happyOut49 happy_x_4 of { happy_var_4 -> + case happyOut46 happy_x_6 of { happy_var_6 -> + happyIn47 + (Internal happy_var_2 happy_var_4 (reverse happy_var_6) + ) `HappyStk` happyRest}}} + +happyReduce_55 = happySpecReduce_3 11# happyReduction_55 +happyReduction_55 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut37 happy_x_2 of { happy_var_2 -> + case happyOut72 happy_x_3 of { happy_var_3 -> + happyIn47 + (Token happy_var_2 happy_var_3 + )}} + +happyReduce_56 = happyReduce 4# 11# happyReduction_56 +happyReduction_56 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut37 happy_x_3 of { happy_var_3 -> + case happyOut72 happy_x_4 of { happy_var_4 -> + happyIn47 + (PosToken happy_var_3 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_57 = happySpecReduce_2 11# happyReduction_57 +happyReduction_57 happy_x_2 + happy_x_1 + = case happyOut73 happy_x_2 of { happy_var_2 -> + happyIn47 + (Entryp happy_var_2 + )} + +happyReduce_58 = happyReduce 4# 11# happyReduction_58 +happyReduction_58 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut68 happy_x_2 of { happy_var_2 -> + case happyOut49 happy_x_3 of { happy_var_3 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn47 + (Separator happy_var_2 happy_var_3 happy_var_4 + ) `HappyStk` happyRest}}} + +happyReduce_59 = happyReduce 4# 11# happyReduction_59 +happyReduction_59 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut68 happy_x_2 of { happy_var_2 -> + case happyOut49 happy_x_3 of { happy_var_3 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn47 + (Terminator happy_var_2 happy_var_3 happy_var_4 + ) `HappyStk` happyRest}}} + +happyReduce_60 = happyReduce 6# 11# happyReduction_60 +happyReduction_60 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut49 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + case happyOut57 happy_x_5 of { happy_var_5 -> + case happyOut68 happy_x_6 of { happy_var_6 -> + happyIn47 + (Delimiters happy_var_2 happy_var_3 happy_var_4 happy_var_5 happy_var_6 + ) `HappyStk` happyRest}}}}} + +happyReduce_61 = happySpecReduce_3 11# happyReduction_61 +happyReduction_61 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut37 happy_x_2 of { happy_var_2 -> + case happyOut38 happy_x_3 of { happy_var_3 -> + happyIn47 + (Coercions happy_var_2 happy_var_3 + )}} + +happyReduce_62 = happyReduce 4# 11# happyReduction_62 +happyReduction_62 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut37 happy_x_2 of { happy_var_2 -> + case happyOut66 happy_x_4 of { happy_var_4 -> + happyIn47 + (Rules happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_63 = happyReduce 5# 11# happyReduction_63 +happyReduction_63 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut37 happy_x_2 of { happy_var_2 -> + case happyOut59 happy_x_3 of { happy_var_3 -> + case happyOut60 happy_x_5 of { happy_var_5 -> + happyIn47 + (Function happy_var_2 (reverse happy_var_3) happy_var_5 + ) `HappyStk` happyRest}}} + +happyReduce_64 = happySpecReduce_2 11# happyReduction_64 +happyReduction_64 happy_x_2 + happy_x_1 + = case happyOut65 happy_x_2 of { happy_var_2 -> + happyIn47 + (Layout happy_var_2 + )} + +happyReduce_65 = happySpecReduce_3 11# happyReduction_65 +happyReduction_65 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut65 happy_x_3 of { happy_var_3 -> + happyIn47 + (LayoutStop happy_var_3 + )} + +happyReduce_66 = happySpecReduce_2 11# happyReduction_66 +happyReduction_66 happy_x_2 + happy_x_1 + = happyIn47 + (LayoutTop + ) + +happyReduce_67 = happySpecReduce_1 12# happyReduction_67 +happyReduction_67 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn48 + (Terminal happy_var_1 + )} + +happyReduce_68 = happySpecReduce_1 12# happyReduction_68 +happyReduction_68 happy_x_1 + = case happyOut49 happy_x_1 of { happy_var_1 -> + happyIn48 + (NTerminal happy_var_1 + )} + +happyReduce_69 = happySpecReduce_3 13# happyReduction_69 +happyReduction_69 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut49 happy_x_2 of { happy_var_2 -> + happyIn49 + (ListCat happy_var_2 + )} + +happyReduce_70 = happySpecReduce_1 13# happyReduction_70 +happyReduction_70 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn49 + (IdCat happy_var_1 + )} + +happyReduce_71 = happySpecReduce_1 14# happyReduction_71 +happyReduction_71 happy_x_1 + = case happyOut51 happy_x_1 of { happy_var_1 -> + happyIn50 + (LabNoP happy_var_1 + )} + +happyReduce_72 = happySpecReduce_2 14# happyReduction_72 +happyReduction_72 happy_x_2 + happy_x_1 + = case happyOut51 happy_x_1 of { happy_var_1 -> + case happyOut56 happy_x_2 of { happy_var_2 -> + happyIn50 + (LabP happy_var_1 happy_var_2 + )}} + +happyReduce_73 = happySpecReduce_3 14# happyReduction_73 +happyReduction_73 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut51 happy_x_1 of { happy_var_1 -> + case happyOut51 happy_x_2 of { happy_var_2 -> + case happyOut56 happy_x_3 of { happy_var_3 -> + happyIn50 + (LabPF happy_var_1 happy_var_2 happy_var_3 + )}}} + +happyReduce_74 = happySpecReduce_2 14# happyReduction_74 +happyReduction_74 happy_x_2 + happy_x_1 + = case happyOut51 happy_x_1 of { happy_var_1 -> + case happyOut51 happy_x_2 of { happy_var_2 -> + happyIn50 + (LabF happy_var_1 happy_var_2 + )}} + +happyReduce_75 = happySpecReduce_1 15# happyReduction_75 +happyReduction_75 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn51 + (Id happy_var_1 + )} + +happyReduce_76 = happySpecReduce_1 15# happyReduction_76 +happyReduction_76 happy_x_1 + = happyIn51 + (Wild + ) + +happyReduce_77 = happySpecReduce_2 15# happyReduction_77 +happyReduction_77 happy_x_2 + happy_x_1 + = happyIn51 + (ListE + ) + +happyReduce_78 = happySpecReduce_3 15# happyReduction_78 +happyReduction_78 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn51 + (ListCons + ) + +happyReduce_79 = happyReduce 5# 15# happyReduction_79 +happyReduction_79 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = happyIn51 + (ListOne + ) `HappyStk` happyRest + +happyReduce_80 = happyReduce 9# 16# happyReduction_80 +happyReduction_80 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut55 happy_x_3 of { happy_var_3 -> + case happyOut54 happy_x_7 of { happy_var_7 -> + happyIn52 + (ProfIt happy_var_3 happy_var_7 + ) `HappyStk` happyRest}} + +happyReduce_81 = happySpecReduce_3 17# happyReduction_81 +happyReduction_81 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut54 happy_x_2 of { happy_var_2 -> + happyIn53 + (Ints happy_var_2 + )} + +happyReduce_82 = happySpecReduce_0 18# happyReduction_82 +happyReduction_82 = happyIn54 + ([] + ) + +happyReduce_83 = happySpecReduce_1 18# happyReduction_83 +happyReduction_83 happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn54 + ((:[]) happy_var_1 + )} + +happyReduce_84 = happySpecReduce_3 18# happyReduction_84 +happyReduction_84 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + case happyOut54 happy_x_3 of { happy_var_3 -> + happyIn54 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_85 = happySpecReduce_0 19# happyReduction_85 +happyReduction_85 = happyIn55 + ([] + ) + +happyReduce_86 = happySpecReduce_1 19# happyReduction_86 +happyReduction_86 happy_x_1 + = case happyOut53 happy_x_1 of { happy_var_1 -> + happyIn55 + ((:[]) happy_var_1 + )} + +happyReduce_87 = happySpecReduce_3 19# happyReduction_87 +happyReduction_87 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut53 happy_x_1 of { happy_var_1 -> + case happyOut55 happy_x_3 of { happy_var_3 -> + happyIn55 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_88 = happySpecReduce_1 20# happyReduction_88 +happyReduction_88 happy_x_1 + = case happyOut52 happy_x_1 of { happy_var_1 -> + happyIn56 + ((:[]) happy_var_1 + )} + +happyReduce_89 = happySpecReduce_2 20# happyReduction_89 +happyReduction_89 happy_x_2 + happy_x_1 + = case happyOut52 happy_x_1 of { happy_var_1 -> + case happyOut56 happy_x_2 of { happy_var_2 -> + happyIn56 + ((:) happy_var_1 happy_var_2 + )}} + +happyReduce_90 = happySpecReduce_0 21# happyReduction_90 +happyReduction_90 = happyIn57 + (SepNone + ) + +happyReduce_91 = happySpecReduce_2 21# happyReduction_91 +happyReduction_91 happy_x_2 + happy_x_1 + = case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn57 + (SepTerm happy_var_2 + )} + +happyReduce_92 = happySpecReduce_2 21# happyReduction_92 +happyReduction_92 happy_x_2 + happy_x_1 + = case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn57 + (SepSepar happy_var_2 + )} + +happyReduce_93 = happySpecReduce_1 22# happyReduction_93 +happyReduction_93 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn58 + (Arg happy_var_1 + )} + +happyReduce_94 = happySpecReduce_0 23# happyReduction_94 +happyReduction_94 = happyIn59 + ([] + ) + +happyReduce_95 = happySpecReduce_2 23# happyReduction_95 +happyReduction_95 happy_x_2 + happy_x_1 + = case happyOut59 happy_x_1 of { happy_var_1 -> + case happyOut58 happy_x_2 of { happy_var_2 -> + happyIn59 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_96 = happySpecReduce_3 24# happyReduction_96 +happyReduction_96 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut61 happy_x_1 of { happy_var_1 -> + case happyOut60 happy_x_3 of { happy_var_3 -> + happyIn60 + (Cons happy_var_1 happy_var_3 + )}} + +happyReduce_97 = happySpecReduce_1 24# happyReduction_97 +happyReduction_97 happy_x_1 + = case happyOut61 happy_x_1 of { happy_var_1 -> + happyIn60 + (happy_var_1 + )} + +happyReduce_98 = happySpecReduce_2 25# happyReduction_98 +happyReduction_98 happy_x_2 + happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut63 happy_x_2 of { happy_var_2 -> + happyIn61 + (App happy_var_1 happy_var_2 + )}} + +happyReduce_99 = happySpecReduce_1 25# happyReduction_99 +happyReduction_99 happy_x_1 + = case happyOut62 happy_x_1 of { happy_var_1 -> + happyIn61 + (happy_var_1 + )} + +happyReduce_100 = happySpecReduce_1 26# happyReduction_100 +happyReduction_100 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn62 + (Var happy_var_1 + )} + +happyReduce_101 = happySpecReduce_1 26# happyReduction_101 +happyReduction_101 happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn62 + (LitInt happy_var_1 + )} + +happyReduce_102 = happySpecReduce_1 26# happyReduction_102 +happyReduction_102 happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + happyIn62 + (LitChar happy_var_1 + )} + +happyReduce_103 = happySpecReduce_1 26# happyReduction_103 +happyReduction_103 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn62 + (LitString happy_var_1 + )} + +happyReduce_104 = happySpecReduce_1 26# happyReduction_104 +happyReduction_104 happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + happyIn62 + (LitDouble happy_var_1 + )} + +happyReduce_105 = happySpecReduce_3 26# happyReduction_105 +happyReduction_105 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut64 happy_x_2 of { happy_var_2 -> + happyIn62 + (List happy_var_2 + )} + +happyReduce_106 = happySpecReduce_3 26# happyReduction_106 +happyReduction_106 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut60 happy_x_2 of { happy_var_2 -> + happyIn62 + (happy_var_2 + )} + +happyReduce_107 = happySpecReduce_1 27# happyReduction_107 +happyReduction_107 happy_x_1 + = case happyOut62 happy_x_1 of { happy_var_1 -> + happyIn63 + ((:[]) happy_var_1 + )} + +happyReduce_108 = happySpecReduce_2 27# happyReduction_108 +happyReduction_108 happy_x_2 + happy_x_1 + = case happyOut62 happy_x_1 of { happy_var_1 -> + case happyOut63 happy_x_2 of { happy_var_2 -> + happyIn63 + ((:) happy_var_1 happy_var_2 + )}} + +happyReduce_109 = happySpecReduce_0 28# happyReduction_109 +happyReduction_109 = happyIn64 + ([] + ) + +happyReduce_110 = happySpecReduce_1 28# happyReduction_110 +happyReduction_110 happy_x_1 + = case happyOut60 happy_x_1 of { happy_var_1 -> + happyIn64 + ((:[]) happy_var_1 + )} + +happyReduce_111 = happySpecReduce_3 28# happyReduction_111 +happyReduction_111 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut60 happy_x_1 of { happy_var_1 -> + case happyOut64 happy_x_3 of { happy_var_3 -> + happyIn64 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_112 = happySpecReduce_1 29# happyReduction_112 +happyReduction_112 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn65 + ((:[]) happy_var_1 + )} + +happyReduce_113 = happySpecReduce_3 29# happyReduction_113 +happyReduction_113 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + case happyOut65 happy_x_3 of { happy_var_3 -> + happyIn65 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_114 = happySpecReduce_1 30# happyReduction_114 +happyReduction_114 happy_x_1 + = case happyOut67 happy_x_1 of { happy_var_1 -> + happyIn66 + ((:[]) happy_var_1 + )} + +happyReduce_115 = happySpecReduce_3 30# happyReduction_115 +happyReduction_115 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut67 happy_x_1 of { happy_var_1 -> + case happyOut66 happy_x_3 of { happy_var_3 -> + happyIn66 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_116 = happySpecReduce_1 31# happyReduction_116 +happyReduction_116 happy_x_1 + = case happyOut46 happy_x_1 of { happy_var_1 -> + happyIn67 + (RHS (reverse happy_var_1) + )} + +happyReduce_117 = happySpecReduce_1 32# happyReduction_117 +happyReduction_117 happy_x_1 + = happyIn68 + (MNonempty + ) + +happyReduce_118 = happySpecReduce_0 32# happyReduction_118 +happyReduction_118 = happyIn68 + (MEmpty + ) + +happyReduce_119 = happySpecReduce_2 33# happyReduction_119 +happyReduction_119 happy_x_2 + happy_x_1 + = case happyOut69 happy_x_1 of { happy_var_1 -> + case happyOut71 happy_x_2 of { happy_var_2 -> + happyIn69 + (RSeq happy_var_1 happy_var_2 + )}} + +happyReduce_120 = happySpecReduce_1 33# happyReduction_120 +happyReduction_120 happy_x_1 + = case happyOut71 happy_x_1 of { happy_var_1 -> + happyIn69 + (happy_var_1 + )} + +happyReduce_121 = happySpecReduce_3 34# happyReduction_121 +happyReduction_121 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut70 happy_x_1 of { happy_var_1 -> + case happyOut69 happy_x_3 of { happy_var_3 -> + happyIn70 + (RAlt happy_var_1 happy_var_3 + )}} + +happyReduce_122 = happySpecReduce_3 34# happyReduction_122 +happyReduction_122 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut69 happy_x_1 of { happy_var_1 -> + case happyOut69 happy_x_3 of { happy_var_3 -> + happyIn70 + (RMinus happy_var_1 happy_var_3 + )}} + +happyReduce_123 = happySpecReduce_1 34# happyReduction_123 +happyReduction_123 happy_x_1 + = case happyOut69 happy_x_1 of { happy_var_1 -> + happyIn70 + (happy_var_1 + )} + +happyReduce_124 = happySpecReduce_2 35# happyReduction_124 +happyReduction_124 happy_x_2 + happy_x_1 + = case happyOut71 happy_x_1 of { happy_var_1 -> + happyIn71 + (RStar happy_var_1 + )} + +happyReduce_125 = happySpecReduce_2 35# happyReduction_125 +happyReduction_125 happy_x_2 + happy_x_1 + = case happyOut71 happy_x_1 of { happy_var_1 -> + happyIn71 + (RPlus happy_var_1 + )} + +happyReduce_126 = happySpecReduce_2 35# happyReduction_126 +happyReduction_126 happy_x_2 + happy_x_1 + = case happyOut71 happy_x_1 of { happy_var_1 -> + happyIn71 + (ROpt happy_var_1 + )} + +happyReduce_127 = happySpecReduce_1 35# happyReduction_127 +happyReduction_127 happy_x_1 + = happyIn71 + (REps + ) + +happyReduce_128 = happySpecReduce_1 35# happyReduction_128 +happyReduction_128 happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + happyIn71 + (RChar happy_var_1 + )} + +happyReduce_129 = happySpecReduce_3 35# happyReduction_129 +happyReduction_129 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn71 + (RAlts happy_var_2 + )} + +happyReduce_130 = happySpecReduce_3 35# happyReduction_130 +happyReduction_130 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn71 + (RSeqs happy_var_2 + )} + +happyReduce_131 = happySpecReduce_1 35# happyReduction_131 +happyReduction_131 happy_x_1 + = happyIn71 + (RDigit + ) + +happyReduce_132 = happySpecReduce_1 35# happyReduction_132 +happyReduction_132 happy_x_1 + = happyIn71 + (RLetter + ) + +happyReduce_133 = happySpecReduce_1 35# happyReduction_133 +happyReduction_133 happy_x_1 + = happyIn71 + (RUpper + ) + +happyReduce_134 = happySpecReduce_1 35# happyReduction_134 +happyReduction_134 happy_x_1 + = happyIn71 + (RLower + ) + +happyReduce_135 = happySpecReduce_1 35# happyReduction_135 +happyReduction_135 happy_x_1 + = happyIn71 + (RAny + ) + +happyReduce_136 = happySpecReduce_3 35# happyReduction_136 +happyReduction_136 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut72 happy_x_2 of { happy_var_2 -> + happyIn71 + (happy_var_2 + )} + +happyReduce_137 = happySpecReduce_1 36# happyReduction_137 +happyReduction_137 happy_x_1 + = case happyOut70 happy_x_1 of { happy_var_1 -> + happyIn72 + (happy_var_1 + )} + +happyReduce_138 = happySpecReduce_1 37# happyReduction_138 +happyReduction_138 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn73 + ((:[]) happy_var_1 + )} + +happyReduce_139 = happySpecReduce_3 37# happyReduction_139 +happyReduction_139 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut73 happy_x_3 of { happy_var_3 -> + happyIn73 + ((:) happy_var_1 happy_var_3 + )}} + +happyNewToken action sts stk [] = + happyDoAction 47# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + PT _ (TS _ 1) -> cont 1#; + PT _ (TS _ 2) -> cont 2#; + PT _ (TS _ 3) -> cont 3#; + PT _ (TS _ 4) -> cont 4#; + PT _ (TS _ 5) -> cont 5#; + PT _ (TS _ 6) -> cont 6#; + PT _ (TS _ 7) -> cont 7#; + PT _ (TS _ 8) -> cont 8#; + PT _ (TS _ 9) -> cont 9#; + PT _ (TS _ 10) -> cont 10#; + PT _ (TS _ 11) -> cont 11#; + PT _ (TS _ 12) -> cont 12#; + PT _ (TS _ 13) -> cont 13#; + PT _ (TS _ 14) -> cont 14#; + PT _ (TS _ 15) -> cont 15#; + PT _ (TS _ 16) -> cont 16#; + PT _ (TS _ 17) -> cont 17#; + PT _ (TS _ 18) -> cont 18#; + PT _ (TS _ 19) -> cont 19#; + PT _ (TS _ 20) -> cont 20#; + PT _ (TS _ 21) -> cont 21#; + PT _ (TS _ 22) -> cont 22#; + PT _ (TS _ 23) -> cont 23#; + PT _ (TS _ 24) -> cont 24#; + PT _ (TS _ 25) -> cont 25#; + PT _ (TS _ 26) -> cont 26#; + PT _ (TS _ 27) -> cont 27#; + PT _ (TS _ 28) -> cont 28#; + PT _ (TS _ 29) -> cont 29#; + PT _ (TS _ 30) -> cont 30#; + PT _ (TS _ 31) -> cont 31#; + PT _ (TS _ 32) -> cont 32#; + PT _ (TS _ 33) -> cont 33#; + PT _ (TS _ 34) -> cont 34#; + PT _ (TS _ 35) -> cont 35#; + PT _ (TS _ 36) -> cont 36#; + PT _ (TS _ 37) -> cont 37#; + PT _ (TS _ 38) -> cont 38#; + PT _ (TS _ 39) -> cont 39#; + PT _ (TS _ 40) -> cont 40#; + PT _ (TL happy_dollar_dollar) -> cont 41#; + PT _ (TV happy_dollar_dollar) -> cont 42#; + PT _ (TI happy_dollar_dollar) -> cont 43#; + PT _ (TC happy_dollar_dollar) -> cont 44#; + PT _ (TD happy_dollar_dollar) -> cont 45#; + _ -> cont 46#; + _ -> happyError' (tk:tks) + } + +happyError_ tk tks = happyError' (tk:tks) + +happyThen :: () => Err a -> (a -> Err b) -> Err b +happyThen = (thenM) +happyReturn :: () => a -> Err a +happyReturn = (returnM) +happyThen1 m k tks = (thenM) m (\a -> k a tks) +happyReturn1 :: () => a -> b -> Err a +happyReturn1 = \a tks -> (returnM) a +happyError' :: () => [(Token)] -> Err a +happyError' = happyError + +pLGrammar tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut41 x)) + +pLDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut42 x)) + +pListLDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut43 x)) + +pGrammar tks = happySomeParser where + happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (happyOut44 x)) + +pListDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 4# tks) (\x -> happyReturn (happyOut45 x)) + +pListItem tks = happySomeParser where + happySomeParser = happyThen (happyParse 5# tks) (\x -> happyReturn (happyOut46 x)) + +pDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 6# tks) (\x -> happyReturn (happyOut47 x)) + +pItem tks = happySomeParser where + happySomeParser = happyThen (happyParse 7# tks) (\x -> happyReturn (happyOut48 x)) + +pCat tks = happySomeParser where + happySomeParser = happyThen (happyParse 8# tks) (\x -> happyReturn (happyOut49 x)) + +pLabel tks = happySomeParser where + happySomeParser = happyThen (happyParse 9# tks) (\x -> happyReturn (happyOut50 x)) + +pLabelId tks = happySomeParser where + happySomeParser = happyThen (happyParse 10# tks) (\x -> happyReturn (happyOut51 x)) + +pProfItem tks = happySomeParser where + happySomeParser = happyThen (happyParse 11# tks) (\x -> happyReturn (happyOut52 x)) + +pIntList tks = happySomeParser where + happySomeParser = happyThen (happyParse 12# tks) (\x -> happyReturn (happyOut53 x)) + +pListInteger tks = happySomeParser where + happySomeParser = happyThen (happyParse 13# tks) (\x -> happyReturn (happyOut54 x)) + +pListIntList tks = happySomeParser where + happySomeParser = happyThen (happyParse 14# tks) (\x -> happyReturn (happyOut55 x)) + +pListProfItem tks = happySomeParser where + happySomeParser = happyThen (happyParse 15# tks) (\x -> happyReturn (happyOut56 x)) + +pSeparation tks = happySomeParser where + happySomeParser = happyThen (happyParse 16# tks) (\x -> happyReturn (happyOut57 x)) + +pArg tks = happySomeParser where + happySomeParser = happyThen (happyParse 17# tks) (\x -> happyReturn (happyOut58 x)) + +pListArg tks = happySomeParser where + happySomeParser = happyThen (happyParse 18# tks) (\x -> happyReturn (happyOut59 x)) + +pExp tks = happySomeParser where + happySomeParser = happyThen (happyParse 19# tks) (\x -> happyReturn (happyOut60 x)) + +pExp1 tks = happySomeParser where + happySomeParser = happyThen (happyParse 20# tks) (\x -> happyReturn (happyOut61 x)) + +pExp2 tks = happySomeParser where + happySomeParser = happyThen (happyParse 21# tks) (\x -> happyReturn (happyOut62 x)) + +pListExp2 tks = happySomeParser where + happySomeParser = happyThen (happyParse 22# tks) (\x -> happyReturn (happyOut63 x)) + +pListExp tks = happySomeParser where + happySomeParser = happyThen (happyParse 23# tks) (\x -> happyReturn (happyOut64 x)) + +pListString tks = happySomeParser where + happySomeParser = happyThen (happyParse 24# tks) (\x -> happyReturn (happyOut65 x)) + +pListRHS tks = happySomeParser where + happySomeParser = happyThen (happyParse 25# tks) (\x -> happyReturn (happyOut66 x)) + +pRHS tks = happySomeParser where + happySomeParser = happyThen (happyParse 26# tks) (\x -> happyReturn (happyOut67 x)) + +pMinimumSize tks = happySomeParser where + happySomeParser = happyThen (happyParse 27# tks) (\x -> happyReturn (happyOut68 x)) + +pReg2 tks = happySomeParser where + happySomeParser = happyThen (happyParse 28# tks) (\x -> happyReturn (happyOut69 x)) + +pReg1 tks = happySomeParser where + happySomeParser = happyThen (happyParse 29# tks) (\x -> happyReturn (happyOut70 x)) + +pReg3 tks = happySomeParser where + happySomeParser = happyThen (happyParse 30# tks) (\x -> happyReturn (happyOut71 x)) + +pReg tks = happySomeParser where + happySomeParser = happyThen (happyParse 31# tks) (\x -> happyReturn (happyOut72 x)) + +pListIdent tks = happySomeParser where + happySomeParser = happyThen (happyParse 32# tks) (\x -> happyReturn (happyOut73 x)) + +happySeq = happyDontSeq + + +returnM :: a -> Err a +returnM = return + +thenM :: Err a -> (a -> Err b) -> Err b +thenM = (>>=) + +happyError :: [Token] -> Err a +happyError ts = + Bad $ "syntax error at " ++ tokenPos ts ++ + case ts of + [] -> [] + [Err _] -> " due to lexer error" + _ -> " before " ++ unwords (map (id . prToken) (take 4 ts)) + +myLexer = tokens +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + +{-# LINE 30 "templates/GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList + + + + + +{-# LINE 51 "templates/GenericTemplate.hs" #-} + +{-# LINE 61 "templates/GenericTemplate.hs" #-} + +{-# LINE 70 "templates/GenericTemplate.hs" #-} + +infixr 9 `HappyStk` +data HappyStk a = HappyStk a (HappyStk a) + +----------------------------------------------------------------------------- +-- starting the parse + +happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll + +----------------------------------------------------------------------------- +-- Accepting the parse + +-- If the current token is 0#, it means we've just accepted a partial +-- parse (a %partial parser). We must ignore the saved token on the top of +-- the stack in this case. +happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} + + (happyReduceArr Happy_Data_Array.! rule) i tk st + where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) + where (off) = indexShortOffAddr happyActOffsets st + (off_i) = (off Happy_GHC_Exts.+# i) + check = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#)) + then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) + else False + (action) + | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + +{-# LINE 130 "templates/GenericTemplate.hs" #-} + + +indexShortOffAddr (HappyA# arr) off = + Happy_GHC_Exts.narrow16Int# i + where + i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) + high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) + low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) + off' = off Happy_GHC_Exts.*# 2# + + + + + +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# + + + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + +{-# LINE 163 "templates/GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) + drop_stk = happyDropStk k stk + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) + drop_stk = happyDropStk k stk + + (off) = indexShortOffAddr happyGotoOffsets st1 + (off_i) = (off Happy_GHC_Exts.+# nt) + (new_state) = indexShortOffAddr happyTable off_i + + + + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where (off) = indexShortOffAddr happyGotoOffsets st + (off_i) = (off Happy_GHC_Exts.+# nt) + (new_state) = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail 0# tk old_st _ stk = +-- trace "failing" $ + happyError_ 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. diff --git a/runtime/Data/Matrix/Class.hs b/runtime/Data/Matrix/Class.hs deleted file mode 100644 --- a/runtime/Data/Matrix/Class.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# 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 - - - - - - diff --git a/src/AbsBNF.hs b/src/AbsBNF.hs --- a/src/AbsBNF.hs +++ b/src/AbsBNF.hs @@ -1,106 +1,120 @@ --- File generated by the BNF Converter (bnfc 2.9.5). - -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- | The abstract syntax of language BNF. - module AbsBNF where -import Prelude (Char, Double, Integer, String) -import qualified Prelude as C (Eq, Ord, Show, Read) -import qualified Data.String +-- Haskell module generated by the BNF converter -data LGrammar = LGr [LDef] - deriving (C.Eq, C.Ord, C.Show, C.Read) -data LDef = DefAll Def | DefSome [Ident] Def | LDefView [Ident] - deriving (C.Eq, C.Ord, C.Show, C.Read) +newtype Ident = Ident String deriving (Eq,Ord,Show) +data LGrammar = + LGr [LDef] + deriving (Eq,Ord,Show) -data Grammar = Grammar [Def] - deriving (C.Eq, C.Ord, C.Show, C.Read) +data LDef = + DefAll Def + | DefSome [Ident] Def + | LDefView [Ident] + deriving (Eq,Ord,Show) -data Def - = Rule Label Cat [Item] - | Comment String - | Comments String String - | Internal Label Cat [Item] - | Token Ident Reg - | PosToken Ident Reg - | Entryp [Ident] - | Separator MinimumSize Cat String - | Terminator MinimumSize Cat String - | Delimiters Cat String String Separation MinimumSize - | Coercions Ident Integer - | Rules Ident [RHS] - | Function Ident [Arg] Exp - | Layout [String] - | LayoutStop [String] - | LayoutTop - deriving (C.Eq, C.Ord, C.Show, C.Read) +data Grammar = + Grammar [Def] + deriving (Eq,Ord,Show) -data Item = Terminal String | NTerminal Cat - deriving (C.Eq, C.Ord, C.Show, C.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) -data Cat = ListCat Cat | IdCat Ident - deriving (C.Eq, C.Ord, C.Show, C.Read) +data Item = + Terminal String + | NTerminal Cat + deriving (Eq,Ord,Show) -data Label - = LabNoP LabelId - | LabP LabelId [ProfItem] - | LabPF LabelId LabelId [ProfItem] - | LabF LabelId LabelId - deriving (C.Eq, C.Ord, C.Show, C.Read) +data Cat = + ListCat Cat + | IdCat Ident + deriving (Eq,Ord,Show) -data LabelId = Id Ident | Wild | ListE | ListCons | ListOne - deriving (C.Eq, C.Ord, C.Show, C.Read) +data Label = + LabNoP LabelId + | LabP LabelId [ProfItem] + | LabPF LabelId LabelId [ProfItem] + | LabF LabelId LabelId + deriving (Eq,Ord,Show) -data ProfItem = ProfIt [IntList] [Integer] - deriving (C.Eq, C.Ord, C.Show, C.Read) +data LabelId = + Id Ident + | Wild + | ListE + | ListCons + | ListOne + deriving (Eq,Ord,Show) -data IntList = Ints [Integer] - deriving (C.Eq, C.Ord, C.Show, C.Read) +data ProfItem = + ProfIt [IntList] [Integer] + deriving (Eq,Ord,Show) -data Separation = SepNone | SepTerm String | SepSepar String - deriving (C.Eq, C.Ord, C.Show, C.Read) +data IntList = + Ints [Integer] + deriving (Eq,Ord,Show) -data Arg = Arg Ident - deriving (C.Eq, C.Ord, C.Show, C.Read) +data Separation = + SepNone + | SepTerm String + | SepSepar String + deriving (Eq,Ord,Show) -data Exp - = Cons Exp Exp - | App Ident [Exp] - | Var Ident - | LitInt Integer - | LitChar Char - | LitString String - | LitDouble Double - | List [Exp] - deriving (C.Eq, C.Ord, C.Show, C.Read) +data Arg = + Arg Ident + deriving (Eq,Ord,Show) -data RHS = RHS [Item] - deriving (C.Eq, C.Ord, C.Show, C.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) -data MinimumSize = MNonempty | MEmpty - deriving (C.Eq, C.Ord, C.Show, C.Read) +data RHS = + RHS [Item] + deriving (Eq,Ord,Show) -data Reg - = RSeq Reg Reg - | RAlt Reg Reg - | RMinus Reg Reg - | RStar Reg - | RPlus Reg - | ROpt Reg - | REps - | RChar Char - | RAlts String - | RSeqs String - | RDigit - | RLetter - | RUpper - | RLower - | RAny - deriving (C.Eq, C.Ord, C.Show, C.Read) +data MinimumSize = + MNonempty + | MEmpty + deriving (Eq,Ord,Show) -newtype Ident = Ident String - deriving (C.Eq, C.Ord, C.Show, C.Read, Data.String.IsString) +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) diff --git a/src/Common/Makefile.hs b/src/Common/Makefile.hs deleted file mode 100644 --- a/src/Common/Makefile.hs +++ /dev/null @@ -1,59 +0,0 @@ -module Common.Makefile where - -import Text.Printf -import Text.Show (ShowS) -- Efficient string concatenation -import System.FilePath (replaceExtension) - -type Makefile = ShowS - - -mkRule :: String -- ^ The target name - -> [String] -- ^ Dependencies - -> [String] -- ^ Recipe - -> Makefile -mkRule target deps recipe = (++) $ unlines $ - [ printf "%s: %s" target (unwords deps) ] - ++ map (printf "\t%s") recipe - ++ [""] - -mkDoc :: String -> Makefile -mkDoc texfile = mkRule "doc" [pdffile] [] - . mkRule pdffile [texfile] - [ printf "pdflatex %s" texfile ] - where pdffile = replaceExtension texfile "pdf" - --- [ --- "all:", --- "\thappy -gca " ++ glr_params ++ happyFile opts, --- "\talex -g " ++ alexFile opts, --- "\t" ++ cd ("latex " ++ basename (latexFile opts) --- ++ "; " ++ "dvips " ++ basename (dviFile opts) --- ++ " -o " ++ basename (psFile opts)), --- "\tghc --make " ++ tFile opts ++ " -o " ++ mkFile withLang "Test" "" opts, --- "clean:", --- "\t-rm -f " ++ unwords (map (dir++) [ --- "*.log", "*.aux", "*.hi", --- "*.o", "*.dvi" --- ]), --- "\t-rm -f " ++ psFile opts, --- --- "distclean: clean", --- "\t-rm -f " ++ unwords [ --- mkFile withLang "Doc" "*" opts, --- mkFile withLang "Lex" "*" opts, --- mkFile withLang "Par" "*" opts, --- mkFile withLang "Layout" "*" opts, --- mkFile withLang "Skel" "*" opts, --- mkFile withLang "Print" "*" opts, --- mkFile withLang "Test" "*" opts, --- mkFile withLang "Abs" "*" opts, --- mkFile withLang "Test" "" opts, --- mkFile noLang "ErrM" "*" opts, --- mkFile noLang "SharedString" "*" opts, --- dir ++ lang opts ++ ".dtd", --- mkFile withLang "XML" "*" opts, --- "Makefile*" --- ], --- if null dir then "" else "\t-rmdir -p " ++ dir --- ] - diff --git a/src/ErrM.hs b/src/ErrM.hs --- a/src/ErrM.hs +++ b/src/ErrM.hs @@ -1,80 +1,21 @@ --- File generated by the BNF Converter (bnfc 2.9.5). - -{-# LANGUAGE CPP #-} - -#if __GLASGOW_HASKELL__ >= 708 ---------------------------------------------------------------------------- --- Pattern synonyms exist since ghc 7.8. - --- | BNF Converter: Error Monad. --- --- Module for backwards compatibility. --- --- The generated parser now uses @'Either' String@ as error monad. --- This module defines a type synonym 'Err' and pattern synonyms --- 'Bad' and 'Ok' for 'Left' and 'Right'. - -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE FlexibleInstances #-} - -module ErrM where - -import Prelude (id, const, Either(..), String) - -import Control.Monad (MonadPlus(..)) -import Control.Applicative (Alternative(..)) -#if __GLASGOW_HASKELL__ >= 808 -import Control.Monad (MonadFail(..)) -#endif - --- | Error monad with 'String' error messages. -type Err = Either String - -pattern Bad msg = Left msg -pattern Ok a = Right a - -#if __GLASGOW_HASKELL__ >= 808 -instance MonadFail Err where - fail = Bad -#endif - -instance Alternative Err where - empty = Left "Err.empty" - (<|>) Left{} = id - (<|>) x@Right{} = const x - -instance MonadPlus Err where - mzero = empty - mplus = (<|>) - -#else ---------------------------------------------------------------------------- --- ghc 7.6 and before: use old definition as data type. - --- | BNF Converter: Error Monad - +-- BNF Converter: Error Monad -- Copyright (C) 2004 Author: Aarne Ranta --- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE. +-- 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.Applicative (Applicative(..), Alternative(..)) -import Control.Monad (MonadPlus(..), liftM) +import Control.Monad (MonadPlus(..), liftM) data Err a = Ok a | Bad String deriving (Read, Show, Eq, Ord) instance Monad Err where return = Ok + fail = Bad Ok a >>= f = f a - Bad s >>= _ = Bad s - -instance Applicative Err where - pure = Ok - (Bad s) <*> _ = Bad s - (Ok f) <*> o = liftM f o + Bad s >>= f = Bad s instance Functor Err where fmap = liftM @@ -83,9 +24,3 @@ mzero = Bad "Err.mzero" mplus (Bad _) y = y mplus x _ = x - -instance Alternative Err where - empty = mzero - (<|>) = mplus - -#endif diff --git a/src/LexBNF.x b/src/LexBNF.x --- a/src/LexBNF.x +++ b/src/LexBNF.x @@ -1,209 +1,103 @@ --- -*- haskell -*- File generated by the BNF Converter (bnfc 2.9.5). - --- Lexer definition for use with Alex 3 +-- -*- haskell -*- +-- This Alex file was machine-generated by the BNF converter { {-# OPTIONS -fno-warn-incomplete-patterns #-} -{-# OPTIONS_GHC -w #-} - -{-# LANGUAGE PatternSynonyms #-} - module LexBNF where -import Prelude + import qualified Data.Bits -import Data.Char (ord) -import Data.Function (on) -import Data.Word (Word8) +import Data.Word (Word8) } --- Predefined character classes -$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter (215 = \times) FIXME -$s = [a-z\222-\255] # [\247] -- small isolatin1 letter (247 = \div ) FIXME -$l = [$c $s] -- letter -$d = [0-9] -- digit -$i = [$l $d _ '] -- identifier character -$u = [. \n] -- universal: any character - --- Symbols and non-identifier-like reserved words +$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 = \: | \; | \. | \: \: \= | \[ | \] | \_ | \( | \) | \, | \= | \| | \- | \* | \+ | \? | \{ | \} +@rsyms = -- symbols and non-identifier-like reserved words + \: | \; | \. | \: \: \= | \[ | \] | \_ | \( | \) | \, | \= | \| | \- | \* | \+ | \? | \{ | \} :- - --- Line comment "--" -"--" [.]* ; - --- Block comment "{-" "-}" -\{ \- [$u # \-]* \- ([$u # [\- \}]] [$u # \-]* \- | \-)* \} ; +"--" [.]* ; -- Toss single line comments +"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; --- Whitespace (skipped) $white+ ; - --- Symbols -@rsyms - { tok (eitherResIdent TV) } - --- Keywords and Ident -$l $i* - { tok (eitherResIdent TV) } - --- String -\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t | r | f)))* \" - { tok (TL . unescapeInitTail) } - --- Char -\' ($u # [\' \\] | \\ [\\ \' n t r f]) \' - { tok TC } - --- Integer -$d+ - { tok TI } +@rsyms { tok (\p s -> PT p (eitherResIdent (TV . share) s)) } --- Double -$d+ \. $d+ (e (\-)? $d+)? - { tok TD } +$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)) } { --- | Create a token with position. -tok :: (String -> Tok) -> (Posn -> String -> Token) -tok f p = PT p . f --- | Token without position. -data Tok - = TK {-# UNPACK #-} !TokSymbol -- ^ Reserved word or symbol. - | TL !String -- ^ String literal. - | TI !String -- ^ Integer literal. - | TV !String -- ^ Identifier. - | TD !String -- ^ Float literal. - | TC !String -- ^ Character literal. - deriving (Eq, Show, Ord) - --- | Smart constructor for 'Tok' for the sake of backwards compatibility. -pattern TS :: String -> Int -> Tok -pattern TS t i = TK (TokSymbol t i) - --- | Keyword or symbol tokens have a unique ID. -data TokSymbol = TokSymbol - { tsText :: String - -- ^ Keyword or symbol text. - , tsID :: !Int - -- ^ Unique ID. - } deriving (Show) +tok f p s = f p s --- | Keyword/symbol equality is determined by the unique ID. -instance Eq TokSymbol where (==) = (==) `on` tsID +share :: String -> String +share = id --- | Keyword/symbol ordering is determined by the unique ID. -instance Ord TokSymbol where compare = compare `on` tsID +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 --- | Token with position. -data Token - = PT Posn Tok - | Err Posn - deriving (Eq, Show, Ord) + deriving (Eq,Show,Ord) --- | Pretty print a position. -printPosn :: Posn -> String -printPosn (Pn _ l c) = "line " ++ show l ++ ", column " ++ show c +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) --- | Pretty print the position of the first token in the list. -tokenPos :: [Token] -> String -tokenPos (t:_) = printPosn (tokenPosn t) -tokenPos [] = "end of file" +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" --- | Get the position of a token. -tokenPosn :: Token -> Posn tokenPosn (PT p _) = p -tokenPosn (Err p) = p - --- | Get line and column of a token. -tokenLineCol :: Token -> (Int, Int) +tokenPosn (Err p) = p tokenLineCol = posLineCol . tokenPosn - --- | Get line and column of a position. -posLineCol :: Posn -> (Int, Int) posLineCol (Pn _ l c) = (l,c) - --- | Convert a token into "position token" form. -mkPosToken :: Token -> ((Int, Int), String) -mkPosToken t = (tokenLineCol t, tokenText t) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) --- | Convert a token to its text. -tokenText :: Token -> String -tokenText t = case t of +prToken t = case t of PT _ (TS s _) -> s - PT _ (TL s) -> show s + PT _ (TL s) -> s PT _ (TI s) -> s PT _ (TV s) -> s PT _ (TD s) -> s PT _ (TC s) -> s - Err _ -> "#error" --- | Convert a token to a string. -prToken :: Token -> String -prToken t = tokenText t --- | Finite map from text to token organized as binary search tree. -data BTree - = N -- ^ Nil (leaf). - | B String Tok BTree BTree - -- ^ Binary node. - deriving (Show) +data BTree = N | B String Tok BTree BTree deriving (Show) --- | Convert potential keyword into token or use fallback conversion. eitherResIdent :: (String -> Tok) -> String -> Tok eitherResIdent tv s = treeFind resWords where treeFind N = tv s - treeFind (B a t left right) = - case compare s a of - LT -> treeFind left - GT -> treeFind right - EQ -> t + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t --- | The keywords and symbols of the language organized as binary search tree. -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 = B bs (TS bs n) - where - bs = s +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) --- | Unquote string literal. unescapeInitTail :: String -> String -unescapeInitTail = id . unesc . tail . id - where +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 - '\\':'r':cs -> '\r' : unesc cs - '\\':'f':cs -> '\f' : unesc cs - '"':[] -> [] - c:cs -> c : unesc cs - _ -> [] + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] ------------------------------------------------------------------- -- Alex wrapper code. @@ -211,7 +105,7 @@ ------------------------------------------------------------------- data Posn = Pn !Int !Int !Int - deriving (Eq, Show, Ord) + deriving (Eq, Show,Ord) alexStartPos :: Posn alexStartPos = Pn 0 1 1 @@ -242,7 +136,7 @@ alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s)) alexGetByte (p, _, [], s) = - case s of + case s of [] -> Nothing (c:s) -> let p' = alexMove p c @@ -252,10 +146,10 @@ alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (p, c, bs, s) = c --- | Encode a Haskell String to a list of Word8 values, in UTF8 format. + -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. utf8Encode :: Char -> [Word8] utf8Encode = map fromIntegral . go . ord - where + where go oc | oc <= 0x7f = [oc] diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,11 +1,6 @@ {- 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. - + Copyright (C) 2002-2010 Authors: Björn Bringert, Johan Broberg, Markus Forberg, Peter Gammie, Patrik Jansson, Antti-Juhani Kaijanaho, Ulf Norell, Michael Pellauer, Aarne Ranta @@ -55,15 +50,14 @@ import Data.List (elemIndex, foldl') import Control.Monad (when,unless) -import Paths_BNFC ( version ) -import Data.Version ( showVersion ) +version = "2.6a" 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, ", + "The BNF Converter, "++version, + "(c) Krasimir Angelov, Jean-Philippe Bernardy, Bjorn Bringert, Johan Broberg, Paul Callaghan, ", + " Markus Forsberg, Ola Frid, Peter Gammie, Patrik Jansson, ", " Kristofer Johannisson, Antti-Juhani Kaijanaho, Ulf Norell, ", - " Michael Pellauer and Aarne Ranta 2002 - 2013.", + " Michael Pellauer and Aarne Ranta 2002 - 2012.", "Free software under GNU General Public License (GPL).", "Bug reports to bnfc-dev@googlegroups.com." ] @@ -74,7 +68,7 @@ case xx of ["--numeric-version"] -> do - putStrLn (showVersion version) + putStrLn version exitSuccess [] -> printUsage _ | elem "-multi" xx -> do diff --git a/src/Options.hs b/src/Options.hs deleted file mode 100644 --- a/src/Options.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Options where - -data Target = TargetC | TargetCPP |TargetCPP_STL - | TargetCSharp | TargetFSharp |TargetHaskell |TargetHaskellGADT - | TargetJava15 |TargetJava |TargetOCAML |TargetProfile - deriving Eq - --- | Which version of Alex is targeted? -data AlexMode = Alex1 | Alex2 | Alex3 deriving Eq - -data HappyMode = Standard | GLR deriving Eq - -data SharedOptions = Options - { - targets :: [Target], - make :: Bool, - alexMode :: AlexMode, - inDir :: Bool, - shareStrings :: Bool, - byteStrings :: Bool, - glr :: HappyMode, - xml :: Int, - inPackage :: Maybe String, -- ^ The hierarchical package to put - -- the modules in, or Nothing. - lang :: String, -- ^ Prefix to use in module names - multi :: Bool, - cnf :: Bool -- ^ Generate CNF-like tables? - } - -anyTarget opts vs = any (isOpt opts) vs - where isOpt opts v = elem v $ targets opts - - - diff --git a/src/ParBNF.y b/src/ParBNF.y --- a/src/ParBNF.y +++ b/src/ParBNF.y @@ -1,52 +1,10 @@ --- -*- haskell -*- File generated by the BNF Converter (bnfc 2.9.5). - --- Parser definition for use with Happy +-- This Happy file was machine-generated by the BNF converter { {-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} -{-# LANGUAGE PatternSynonyms #-} - -module ParBNF - ( happyError - , myLexer - , pLGrammar - , pLDef - , pListLDef - , pGrammar - , pListDef - , pListItem - , pDef - , pItem - , pCat - , pLabel - , pLabelId - , pProfItem - , pIntList - , pListInteger - , pListIntList - , pListProfItem - , pSeparation - , pArg - , pListArg - , pExp - , pExp1 - , pExp2 - , pListExp2 - , pListExp - , pListString - , pListRHS - , pRHS - , pMinimumSize - , pReg2 - , pReg1 - , pReg3 - , pReg - , pListIdent - ) where - -import Prelude - -import qualified AbsBNF +module ParBNF where +import AbsBNF import LexBNF +import ErrM } @@ -83,259 +41,287 @@ %name pReg3 Reg3 %name pReg Reg %name pListIdent ListIdent + -- no lexer declaration -%monad { Err } { (>>=) } { return } -%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_Ident { PT _ (TV $$) } - L_charac { PT _ (TC $$) } - L_doubl { PT _ (TD $$) } - L_integ { PT _ (TI $$) } - L_quoted { PT _ (TL $$) } +%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) } -Ident :: { AbsBNF.Ident } -Ident : L_Ident { AbsBNF.Ident $1 } +L_quoted { PT _ (TL $$) } +L_ident { PT _ (TV $$) } +L_integ { PT _ (TI $$) } +L_charac { PT _ (TC $$) } +L_doubl { PT _ (TD $$) } +L_err { _ } -Char :: { Char } -Char : L_charac { (read $1) :: Char } -Double :: { Double } -Double : L_doubl { (read $1) :: Double } +%% -Integer :: { Integer } -Integer : L_integ { (read $1) :: Integer } +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 } -String :: { String } -String : L_quoted { $1 } +LGrammar :: { LGrammar } +LGrammar : ListLDef { LGr $1 } -LGrammar :: { AbsBNF.LGrammar } -LGrammar : ListLDef { AbsBNF.LGr $1 } -LDef :: { AbsBNF.LDef } -LDef - : Def { AbsBNF.DefAll $1 } - | ListIdent ':' Def { AbsBNF.DefSome $1 $3 } - | 'views' ListIdent { AbsBNF.LDefView $2 } +LDef :: { LDef } +LDef : Def { DefAll $1 } + | ListIdent ':' Def { DefSome $1 $3 } + | 'views' ListIdent { LDefView $2 } -ListLDef :: { [AbsBNF.LDef] } -ListLDef - : {- empty -} { [] } + +ListLDef :: { [LDef] } +ListLDef : {- empty -} { [] } | LDef { (:[]) $1 } | LDef ';' ListLDef { (:) $1 $3 } -Grammar :: { AbsBNF.Grammar } -Grammar : ListDef { AbsBNF.Grammar $1 } -ListDef :: { [AbsBNF.Def] } -ListDef - : {- empty -} { [] } +Grammar :: { Grammar } +Grammar : ListDef { Grammar $1 } + + +ListDef :: { [Def] } +ListDef : {- empty -} { [] } | Def { (:[]) $1 } | Def ';' ListDef { (:) $1 $3 } -ListItem :: { [AbsBNF.Item] } -ListItem : {- empty -} { [] } | Item ListItem { (:) $1 $2 } -Def :: { AbsBNF.Def } -Def - : Label '.' Cat '::=' ListItem { AbsBNF.Rule $1 $3 $5 } - | 'comment' String { AbsBNF.Comment $2 } - | 'comment' String String { AbsBNF.Comments $2 $3 } - | 'internal' Label '.' Cat '::=' ListItem { AbsBNF.Internal $2 $4 $6 } - | 'token' Ident Reg { AbsBNF.Token $2 $3 } - | 'position' 'token' Ident Reg { AbsBNF.PosToken $3 $4 } - | 'entrypoints' ListIdent { AbsBNF.Entryp $2 } - | 'separator' MinimumSize Cat String { AbsBNF.Separator $2 $3 $4 } - | 'terminator' MinimumSize Cat String { AbsBNF.Terminator $2 $3 $4 } - | 'delimiters' Cat String String Separation MinimumSize { AbsBNF.Delimiters $2 $3 $4 $5 $6 } - | 'coercions' Ident Integer { AbsBNF.Coercions $2 $3 } - | 'rules' Ident '::=' ListRHS { AbsBNF.Rules $2 $4 } - | 'define' Ident ListArg '=' Exp { AbsBNF.Function $2 $3 $5 } - | 'layout' ListString { AbsBNF.Layout $2 } - | 'layout' 'stop' ListString { AbsBNF.LayoutStop $3 } - | 'layout' 'toplevel' { AbsBNF.LayoutTop } +ListItem :: { [Item] } +ListItem : {- empty -} { [] } + | ListItem Item { flip (:) $1 $2 } -Item :: { AbsBNF.Item } -Item : String { AbsBNF.Terminal $1 } | Cat { AbsBNF.NTerminal $1 } -Cat :: { AbsBNF.Cat } -Cat : '[' Cat ']' { AbsBNF.ListCat $2 } | Ident { AbsBNF.IdCat $1 } +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 } -Label :: { AbsBNF.Label } -Label - : LabelId { AbsBNF.LabNoP $1 } - | LabelId ListProfItem { AbsBNF.LabP $1 $2 } - | LabelId LabelId ListProfItem { AbsBNF.LabPF $1 $2 $3 } - | LabelId LabelId { AbsBNF.LabF $1 $2 } -LabelId :: { AbsBNF.LabelId } -LabelId - : Ident { AbsBNF.Id $1 } - | '_' { AbsBNF.Wild } - | '[' ']' { AbsBNF.ListE } - | '(' ':' ')' { AbsBNF.ListCons } - | '(' ':' '[' ']' ')' { AbsBNF.ListOne } +Item :: { Item } +Item : String { Terminal $1 } + | Cat { NTerminal $1 } -ProfItem :: { AbsBNF.ProfItem } -ProfItem - : '(' '[' ListIntList ']' ',' '[' ListInteger ']' ')' { AbsBNF.ProfIt $3 $7 } -IntList :: { AbsBNF.IntList } -IntList : '[' ListInteger ']' { AbsBNF.Ints $2 } +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 -} { [] } +ListInteger : {- empty -} { [] } | Integer { (:[]) $1 } | Integer ',' ListInteger { (:) $1 $3 } -ListIntList :: { [AbsBNF.IntList] } -ListIntList - : {- empty -} { [] } + +ListIntList :: { [IntList] } +ListIntList : {- empty -} { [] } | IntList { (:[]) $1 } | IntList ',' ListIntList { (:) $1 $3 } -ListProfItem :: { [AbsBNF.ProfItem] } -ListProfItem - : ProfItem { (:[]) $1 } | ProfItem ListProfItem { (:) $1 $2 } -Separation :: { AbsBNF.Separation } -Separation - : {- empty -} { AbsBNF.SepNone } - | 'terminator' String { AbsBNF.SepTerm $2 } - | 'separator' String { AbsBNF.SepSepar $2 } +ListProfItem :: { [ProfItem] } +ListProfItem : ProfItem { (:[]) $1 } + | ProfItem ListProfItem { (:) $1 $2 } -Arg :: { AbsBNF.Arg } -Arg : Ident { AbsBNF.Arg $1 } -ListArg :: { [AbsBNF.Arg] } -ListArg : {- empty -} { [] } | Arg ListArg { (:) $1 $2 } +Separation :: { Separation } +Separation : {- empty -} { SepNone } + | 'terminator' String { SepTerm $2 } + | 'separator' String { SepSepar $2 } -Exp :: { AbsBNF.Exp } -Exp : Exp1 ':' Exp { AbsBNF.Cons $1 $3 } | Exp1 { $1 } -Exp1 :: { AbsBNF.Exp } -Exp1 : Ident ListExp2 { AbsBNF.App $1 $2 } | Exp2 { $1 } +Arg :: { Arg } +Arg : Ident { Arg $1 } -Exp2 :: { AbsBNF.Exp } -Exp2 - : Ident { AbsBNF.Var $1 } - | Integer { AbsBNF.LitInt $1 } - | Char { AbsBNF.LitChar $1 } - | String { AbsBNF.LitString $1 } - | Double { AbsBNF.LitDouble $1 } - | '[' ListExp ']' { AbsBNF.List $2 } + +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 :: { [AbsBNF.Exp] } -ListExp2 : Exp2 { (:[]) $1 } | Exp2 ListExp2 { (:) $1 $2 } -ListExp :: { [AbsBNF.Exp] } -ListExp - : {- empty -} { [] } +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 } +ListString : String { (:[]) $1 } + | String ',' ListString { (:) $1 $3 } -ListRHS :: { [AbsBNF.RHS] } -ListRHS : RHS { (:[]) $1 } | RHS '|' ListRHS { (:) $1 $3 } -RHS :: { AbsBNF.RHS } -RHS : ListItem { AbsBNF.RHS $1 } +ListRHS :: { [RHS] } +ListRHS : RHS { (:[]) $1 } + | RHS '|' ListRHS { (:) $1 $3 } -MinimumSize :: { AbsBNF.MinimumSize } -MinimumSize - : 'nonempty' { AbsBNF.MNonempty } | {- empty -} { AbsBNF.MEmpty } -Reg2 :: { AbsBNF.Reg } -Reg2 : Reg2 Reg3 { AbsBNF.RSeq $1 $2 } | Reg3 { $1 } +RHS :: { RHS } +RHS : ListItem { RHS (reverse $1) } -Reg1 :: { AbsBNF.Reg } -Reg1 - : Reg1 '|' Reg2 { AbsBNF.RAlt $1 $3 } - | Reg2 '-' Reg2 { AbsBNF.RMinus $1 $3 } + +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 :: { AbsBNF.Reg } -Reg3 - : Reg3 '*' { AbsBNF.RStar $1 } - | Reg3 '+' { AbsBNF.RPlus $1 } - | Reg3 '?' { AbsBNF.ROpt $1 } - | 'eps' { AbsBNF.REps } - | Char { AbsBNF.RChar $1 } - | '[' String ']' { AbsBNF.RAlts $2 } - | '{' String '}' { AbsBNF.RSeqs $2 } - | 'digit' { AbsBNF.RDigit } - | 'letter' { AbsBNF.RLetter } - | 'upper' { AbsBNF.RUpper } - | 'lower' { AbsBNF.RLower } - | 'char' { AbsBNF.RAny } + +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 :: { AbsBNF.Reg } -Reg : Reg1 { $1 } -ListIdent :: { [AbsBNF.Ident] } -ListIdent : Ident { (:[]) $1 } | Ident ',' ListIdent { (:) $1 $3 } +Reg :: { Reg } +Reg : Reg1 { $1 } + +ListIdent :: { [Ident] } +ListIdent : Ident { (:[]) $1 } + | Ident ',' ListIdent { (:) $1 $3 } + + + { -type Err = Either String +returnM :: a -> Err a +returnM = return +thenM :: Err a -> (a -> Err b) -> Err b +thenM = (>>=) + happyError :: [Token] -> Err a -happyError ts = Left $ - "syntax error at " ++ tokenPos ts ++ +happyError ts = + Bad $ "syntax error at " ++ tokenPos ts ++ case ts of - [] -> [] + [] -> [] [Err _] -> " due to lexer error" - t:_ -> " before `" ++ (prToken t) ++ "'" + _ -> " before " ++ unwords (map (id . prToken) (take 4 ts)) -myLexer :: String -> [Token] myLexer = tokens - } diff --git a/src/PrintBNF.hs b/src/PrintBNF.hs --- a/src/PrintBNF.hs +++ b/src/PrintBNF.hs @@ -1,29 +1,13 @@ --- File generated by the BNF Converter (bnfc 2.9.5). - -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -#if __GLASGOW_HASKELL__ <= 708 -{-# LANGUAGE OverlappingInstances #-} -#endif - --- | Pretty-printer for PrintBNF. - +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} module PrintBNF where -import Prelude - ( ($), (.) - , Bool(..), (==), (<) - , Int, Integer, Double, (+), (-), (*) - , String, (++) - , ShowS, showChar, showString - , all, elem, foldr, id, map, null, replicate, shows, span - ) -import Data.Char ( Char, isSpace ) -import qualified AbsBNF +-- pretty-printer generated by the BNF converter --- | The top-level printing method. +import AbsBNF +import Data.Char + +-- the top-level printing method printTree :: Print a => a -> String printTree = render . prt 0 @@ -33,63 +17,21 @@ doc = (:) render :: Doc -> String -render d = rend 0 False (map ($ "") $ d []) "" - where - rend - :: Int -- ^ Indentation level. - -> Bool -- ^ Pending indentation to be output before next character? - -> [String] - -> ShowS - rend i p = \case - "[" :ts -> char '[' . rend i False ts - "(" :ts -> char '(' . rend i False ts - "{" :ts -> onNewLine i p . showChar '{' . new (i+1) ts - "}" : ";":ts -> onNewLine (i-1) p . showString "};" . new (i-1) ts - "}" :ts -> onNewLine (i-1) p . showChar '}' . new (i-1) ts - [";"] -> char ';' - ";" :ts -> char ';' . new i ts - t : ts@(s:_) | closingOrPunctuation s - -> pending . showString t . rend i False ts - t :ts -> pending . space t . rend i False ts - [] -> id - where - -- Output character after pending indentation. - char :: Char -> ShowS - char c = pending . showChar c - - -- Output pending indentation. - pending :: ShowS - pending = if p then indent i else id - - -- Indentation (spaces) for given indentation level. - indent :: Int -> ShowS - indent i = replicateS (2*i) (showChar ' ') - - -- Continue rendering in new line with new indentation. - new :: Int -> [String] -> ShowS - new j ts = showChar '\n' . rend j True ts - - -- Make sure we are on a fresh line. - onNewLine :: Int -> Bool -> ShowS - onNewLine i p = (if p then id else showChar '\n') . indent i - - -- Separate given string from following text by a space (if needed). - space :: String -> ShowS - space t s = - case (all isSpace t, null spc, null rest) of - (True , _ , True ) -> [] -- remove trailing space - (False, _ , True ) -> t -- remove trailing space - (False, True, False) -> t ++ ' ' : s -- add space if none - _ -> t ++ s - where - (spc, rest) = span isSpace s - - closingOrPunctuation :: String -> Bool - closingOrPunctuation [c] = c `elem` closerOrPunct - closingOrPunctuation _ = False - - closerOrPunct :: String - closerOrPunct = ")],;" +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 ')') @@ -103,207 +45,209 @@ replicateS :: Int -> ShowS -> ShowS replicateS n f = concatS (replicate n f) --- | The printer class does the job. - +-- the printer class does the job class Print a where prt :: Int -> a -> Doc + prtList :: [a] -> Doc + prtList = concatD . map (prt 0) -instance {-# OVERLAPPABLE #-} Print a => Print [a] where - prt i = concatD . map (prt i) +instance Print a => Print [a] where + prt _ = prtList instance Print Char where - prt _ c = doc (showChar '\'' . mkEsc '\'' c . showChar '\'') - -instance Print String where - prt _ = printString - -printString :: String -> Doc -printString s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"') + prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'') + prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"') mkEsc :: Char -> Char -> ShowS -mkEsc q = \case - s | s == q -> showChar '\\' . showChar s - '\\' -> showString "\\\\" +mkEsc q s = case s of + _ | s == q -> showChar '\\' . showChar s + '\\'-> showString "\\\\" '\n' -> showString "\\n" '\t' -> showString "\\t" - s -> showChar s + _ -> showChar s prPrec :: Int -> Int -> Doc -> Doc -prPrec i j = if j < i then parenth else id +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 AbsBNF.Ident where - prt _ (AbsBNF.Ident i) = doc $ showString i -instance Print AbsBNF.LGrammar where - prt i = \case - AbsBNF.LGr ldefs -> prPrec i 0 (concatD [prt 0 ldefs]) -instance Print AbsBNF.LDef where - prt i = \case - AbsBNF.DefAll def -> prPrec i 0 (concatD [prt 0 def]) - AbsBNF.DefSome ids def -> prPrec i 0 (concatD [prt 0 ids, doc (showString ":"), prt 0 def]) - AbsBNF.LDefView ids -> prPrec i 0 (concatD [doc (showString "views"), prt 0 ids]) +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 [AbsBNF.LDef] where - prt _ [] = concatD [] - prt _ [x] = concatD [prt 0 x] - prt _ (x:xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs] -instance Print AbsBNF.Grammar where - prt i = \case - AbsBNF.Grammar defs -> prPrec i 0 (concatD [prt 0 defs]) -instance Print [AbsBNF.Def] where - prt _ [] = concatD [] - prt _ [x] = concatD [prt 0 x] - prt _ (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 [AbsBNF.Item] where - prt _ [] = concatD [] - prt _ (x:xs) = concatD [prt 0 x, prt 0 xs] -instance Print AbsBNF.Def where - prt i = \case - AbsBNF.Rule label cat items -> prPrec i 0 (concatD [prt 0 label, doc (showString "."), prt 0 cat, doc (showString "::="), prt 0 items]) - AbsBNF.Comment str -> prPrec i 0 (concatD [doc (showString "comment"), printString str]) - AbsBNF.Comments str1 str2 -> prPrec i 0 (concatD [doc (showString "comment"), printString str1, printString str2]) - AbsBNF.Internal label cat items -> prPrec i 0 (concatD [doc (showString "internal"), prt 0 label, doc (showString "."), prt 0 cat, doc (showString "::="), prt 0 items]) - AbsBNF.Token id_ reg -> prPrec i 0 (concatD [doc (showString "token"), prt 0 id_, prt 0 reg]) - AbsBNF.PosToken id_ reg -> prPrec i 0 (concatD [doc (showString "position"), doc (showString "token"), prt 0 id_, prt 0 reg]) - AbsBNF.Entryp ids -> prPrec i 0 (concatD [doc (showString "entrypoints"), prt 0 ids]) - AbsBNF.Separator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "separator"), prt 0 minimumsize, prt 0 cat, printString str]) - AbsBNF.Terminator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "terminator"), prt 0 minimumsize, prt 0 cat, printString str]) - AbsBNF.Delimiters cat str1 str2 separation minimumsize -> prPrec i 0 (concatD [doc (showString "delimiters"), prt 0 cat, printString str1, printString str2, prt 0 separation, prt 0 minimumsize]) - AbsBNF.Coercions id_ n -> prPrec i 0 (concatD [doc (showString "coercions"), prt 0 id_, prt 0 n]) - AbsBNF.Rules id_ rhss -> prPrec i 0 (concatD [doc (showString "rules"), prt 0 id_, doc (showString "::="), prt 0 rhss]) - AbsBNF.Function id_ args exp -> prPrec i 0 (concatD [doc (showString "define"), prt 0 id_, prt 0 args, doc (showString "="), prt 0 exp]) - AbsBNF.Layout strs -> prPrec i 0 (concatD [doc (showString "layout"), prt 0 strs]) - AbsBNF.LayoutStop strs -> prPrec i 0 (concatD [doc (showString "layout"), doc (showString "stop"), prt 0 strs]) - AbsBNF.LayoutTop -> prPrec i 0 (concatD [doc (showString "layout"), doc (showString "toplevel")]) +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]) -instance Print AbsBNF.Item where - prt i = \case - AbsBNF.Terminal str -> prPrec i 0 (concatD [printString str]) - AbsBNF.NTerminal cat -> prPrec i 0 (concatD [prt 0 cat]) + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) -instance Print AbsBNF.Cat where - prt i = \case - AbsBNF.ListCat cat -> prPrec i 0 (concatD [doc (showString "["), prt 0 cat, doc (showString "]")]) - AbsBNF.IdCat id_ -> prPrec i 0 (concatD [prt 0 id_]) +instance Print Grammar where + prt i e = case e of + Grammar defs -> prPrec i 0 (concatD [prt 0 defs]) -instance Print AbsBNF.Label where - prt i = \case - AbsBNF.LabNoP labelid -> prPrec i 0 (concatD [prt 0 labelid]) - AbsBNF.LabP labelid profitems -> prPrec i 0 (concatD [prt 0 labelid, prt 0 profitems]) - AbsBNF.LabPF labelid1 labelid2 profitems -> prPrec i 0 (concatD [prt 0 labelid1, prt 0 labelid2, prt 0 profitems]) - AbsBNF.LabF labelid1 labelid2 -> prPrec i 0 (concatD [prt 0 labelid1, prt 0 labelid2]) -instance Print AbsBNF.LabelId where - prt i = \case - AbsBNF.Id id_ -> prPrec i 0 (concatD [prt 0 id_]) - AbsBNF.Wild -> prPrec i 0 (concatD [doc (showString "_")]) - AbsBNF.ListE -> prPrec i 0 (concatD [doc (showString "["), doc (showString "]")]) - AbsBNF.ListCons -> prPrec i 0 (concatD [doc (showString "("), doc (showString ":"), doc (showString ")")]) - AbsBNF.ListOne -> prPrec i 0 (concatD [doc (showString "("), doc (showString ":"), doc (showString "["), doc (showString "]"), doc (showString ")")]) +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")]) -instance Print AbsBNF.ProfItem where - prt i = \case - AbsBNF.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 + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) -instance Print AbsBNF.IntList where - prt i = \case - AbsBNF.Ints ns -> prPrec i 0 (concatD [doc (showString "["), prt 0 ns, doc (showString "]")]) +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]) -instance Print [Integer] where - prt _ [] = concatD [] - prt _ [x] = concatD [prt 0 x] - prt _ (x:xs) = concatD [prt 0 x, doc (showString ","), prt 0 xs] + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) -instance Print [AbsBNF.IntList] where - prt _ [] = concatD [] - prt _ [x] = concatD [prt 0 x] - prt _ (x:xs) = concatD [prt 0 x, doc (showString ","), 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 [AbsBNF.ProfItem] where - prt _ [] = concatD [] - prt _ [x] = concatD [prt 0 x] - prt _ (x:xs) = concatD [prt 0 x, prt 0 xs] -instance Print AbsBNF.Separation where - prt i = \case - AbsBNF.SepNone -> prPrec i 0 (concatD []) - AbsBNF.SepTerm str -> prPrec i 0 (concatD [doc (showString "terminator"), printString str]) - AbsBNF.SepSepar str -> prPrec i 0 (concatD [doc (showString "separator"), printString str]) +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 AbsBNF.Arg where - prt i = \case - AbsBNF.Arg id_ -> prPrec i 0 (concatD [prt 0 id_]) -instance Print [AbsBNF.Arg] where - prt _ [] = concatD [] - prt _ (x:xs) = concatD [prt 0 x, prt 0 xs] +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 AbsBNF.Exp where - prt i = \case - AbsBNF.Cons exp1 exp2 -> prPrec i 0 (concatD [prt 1 exp1, doc (showString ":"), prt 0 exp2]) - AbsBNF.App id_ exps -> prPrec i 1 (concatD [prt 0 id_, prt 2 exps]) - AbsBNF.Var id_ -> prPrec i 2 (concatD [prt 0 id_]) - AbsBNF.LitInt n -> prPrec i 2 (concatD [prt 0 n]) - AbsBNF.LitChar c -> prPrec i 2 (concatD [prt 0 c]) - AbsBNF.LitString str -> prPrec i 2 (concatD [printString str]) - AbsBNF.LitDouble d -> prPrec i 2 (concatD [prt 0 d]) - AbsBNF.List exps -> prPrec i 2 (concatD [doc (showString "["), prt 0 exps, doc (showString "]")]) -instance Print [AbsBNF.Exp] where - prt 2 [x] = concatD [prt 2 x] - prt 2 (x:xs) = concatD [prt 2 x, prt 2 xs] - prt _ [] = concatD [] - prt _ [x] = concatD [prt 0 x] - prt _ (x:xs) = concatD [prt 0 x, doc (showString ","), prt 0 xs] +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 ")")]) -instance Print [String] where - prt _ [] = concatD [] - prt _ [x] = concatD [printString x] - prt _ (x:xs) = concatD [printString x, doc (showString ","), prt 0 xs] + prtList es = case es of + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , prt 0 xs]) -instance Print [AbsBNF.RHS] where - prt _ [] = concatD [] - prt _ [x] = concatD [prt 0 x] - prt _ (x:xs) = concatD [prt 0 x, doc (showString "|"), 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 "]")]) -instance Print AbsBNF.RHS where - prt i = \case - AbsBNF.RHS items -> prPrec i 0 (concatD [prt 0 items]) + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) -instance Print AbsBNF.MinimumSize where - prt i = \case - AbsBNF.MNonempty -> prPrec i 0 (concatD [doc (showString "nonempty")]) - AbsBNF.MEmpty -> prPrec i 0 (concatD []) +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 AbsBNF.Reg where - prt i = \case - AbsBNF.RSeq reg1 reg2 -> prPrec i 2 (concatD [prt 2 reg1, prt 3 reg2]) - AbsBNF.RAlt reg1 reg2 -> prPrec i 1 (concatD [prt 1 reg1, doc (showString "|"), prt 2 reg2]) - AbsBNF.RMinus reg1 reg2 -> prPrec i 1 (concatD [prt 2 reg1, doc (showString "-"), prt 2 reg2]) - AbsBNF.RStar reg -> prPrec i 3 (concatD [prt 3 reg, doc (showString "*")]) - AbsBNF.RPlus reg -> prPrec i 3 (concatD [prt 3 reg, doc (showString "+")]) - AbsBNF.ROpt reg -> prPrec i 3 (concatD [prt 3 reg, doc (showString "?")]) - AbsBNF.REps -> prPrec i 3 (concatD [doc (showString "eps")]) - AbsBNF.RChar c -> prPrec i 3 (concatD [prt 0 c]) - AbsBNF.RAlts str -> prPrec i 3 (concatD [doc (showString "["), printString str, doc (showString "]")]) - AbsBNF.RSeqs str -> prPrec i 3 (concatD [doc (showString "{"), printString str, doc (showString "}")]) - AbsBNF.RDigit -> prPrec i 3 (concatD [doc (showString "digit")]) - AbsBNF.RLetter -> prPrec i 3 (concatD [doc (showString "letter")]) - AbsBNF.RUpper -> prPrec i 3 (concatD [doc (showString "upper")]) - AbsBNF.RLower -> prPrec i 3 (concatD [doc (showString "lower")]) - AbsBNF.RAny -> prPrec i 3 (concatD [doc (showString "char")]) -instance Print [AbsBNF.Ident] where - prt _ [] = concatD [] - prt _ [x] = concatD [prt 0 x] - prt _ (x:xs) = concatD [prt 0 x, doc (showString ","), prt 0 xs] +instance Print Arg where + prt i e = case e of + Arg id -> prPrec i 0 (concatD [prt 0 id]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) + +instance Print Exp where + prt i e = case e of + Cons exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString ":") , prt 0 exp]) + App id exps -> prPrec i 1 (concatD [prt 0 id , prt 2 exps]) + Var id -> prPrec i 2 (concatD [prt 0 id]) + LitInt n -> prPrec i 2 (concatD [prt 0 n]) + LitChar c -> prPrec i 2 (concatD [prt 0 c]) + LitString str -> prPrec i 2 (concatD [prt 0 str]) + LitDouble d -> prPrec i 2 (concatD [prt 0 d]) + List exps -> prPrec i 2 (concatD [doc (showString "[") , prt 0 exps , doc (showString "]")]) + + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 2 x]) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 2 x , prt 2 xs]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) + +instance Print RHS where + prt i e = case e of + RHS items -> prPrec i 0 (concatD [prt 0 items]) + + prtList es = case es of + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs]) + +instance Print MinimumSize where + prt i e = case e of + MNonempty -> prPrec i 0 (concatD [doc (showString "nonempty")]) + MEmpty -> prPrec i 0 (concatD []) + + +instance Print Reg where + prt i e = case e of + RSeq reg0 reg -> prPrec i 2 (concatD [prt 2 reg0 , prt 3 reg]) + RAlt reg0 reg -> prPrec i 1 (concatD [prt 1 reg0 , doc (showString "|") , prt 2 reg]) + RMinus reg0 reg -> prPrec i 1 (concatD [prt 2 reg0 , doc (showString "-") , prt 2 reg]) + RStar reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "*")]) + RPlus reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "+")]) + ROpt reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "?")]) + REps -> prPrec i 3 (concatD [doc (showString "eps")]) + RChar c -> prPrec i 3 (concatD [prt 0 c]) + RAlts str -> prPrec i 3 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")]) + RSeqs str -> prPrec i 3 (concatD [doc (showString "{") , prt 0 str , doc (showString "}")]) + RDigit -> prPrec i 3 (concatD [doc (showString "digit")]) + RLetter -> prPrec i 3 (concatD [doc (showString "letter")]) + RUpper -> prPrec i 3 (concatD [doc (showString "upper")]) + RLower -> prPrec i 3 (concatD [doc (showString "lower")]) + RAny -> prPrec i 3 (concatD [doc (showString "char")]) + + + diff --git a/src/formats/c/CFtoBisonC.hs b/src/formats/c/CFtoBisonC.hs --- a/src/formats/c/CFtoBisonC.hs +++ b/src/formats/c/CFtoBisonC.hs @@ -67,7 +67,7 @@ declarations cf, specialToks cf, "%%", - prRules (rulesForBison cf env) + prRules (rulesForBison name cf env) ] where user = fst (unzip (tokenPragmas cf)) @@ -191,8 +191,8 @@ --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 +rulesForBison :: String -> CF -> SymEnv -> Rules +rulesForBison name cf env = map mkOne $ ruleGroups cf where mkOne (cat,rules) = constructRule cf env rules cat -- For every non-terminal, we construct a set of rules. diff --git a/src/formats/c/CTop.hs b/src/formats/c/CTop.hs --- a/src/formats/c/CTop.hs +++ b/src/formats/c/CTop.hs @@ -28,17 +28,16 @@ import CFtoLatex import Data.Char import System.Exit (exitFailure) -import qualified Common.Makefile as Makefile makeC :: Bool -> String -> CF -> IO () makeC make name cf = do - let (hfile, cfile) = cf2CAbs prefix cf + let (hfile, cfile) = cf2CAbs name cf writeFileRep "Absyn.h" hfile writeFileRep "Absyn.c" cfile - let (flex, env) = cf2flex prefix cf + let (flex, env) = cf2flex name cf writeFileRep (name ++ ".l") flex putStrLn " (Tested with flex 2.5.31)" - let bison = cf2Bison prefix cf env + let bison = cf2Bison name cf env writeFileRep (name ++ ".y") bison putStrLn " (Tested with bison 1.875a)" let header = mkHeaderFile cf (allCats cf) (allEntryPoints cf) env @@ -52,57 +51,62 @@ writeFileRep "Test.c" (ctest cf) let latex = cfToLatex name cf writeFileRep (name ++ ".tex") latex - if make then (writeFileRep "Makefile" $ makefile name prefix) else return () - 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 + if make then (writeFileRep "Makefile" $ makefile name) else return () -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, ""]) - $ 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 " ++ unwords [ name ++ e | e <- [".aux",".log",".pdf",""]] ] - $ Makefile.mkRule "distclean" ["clean"] -- FIXME - [ "rm -f " ++ unwords - [ "Absyn.c", "Absyn.h", "Test.c", "Parser.c", "Parser.h", "Lexer.c" - , "Skeleton.c", "Skeleton.h", "Printer.c" ,"Printer.h" - , name ++ ".l " ++ name ++ ".y " ++ name ++ ".tex " - , testName, "Makefile" ]] - $ Makefile.mkRule testName ["Absyn.o", "Lexer.o", "Parser.o", "Printer.o", "Test.o"] - [ "@echo \"Linking test" ++ name ++ "...\"" - , "${CC} ${CCFLAGS} *.o -o Test" ++ name ] - $ 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" ] - $ Makefile.mkDoc (name ++ ".tex") - "" - where testName = "Test" ++ name +makefile :: String -> String +makefile name = unlines + [ + "CC = gcc", + "CCFLAGS = -g -W -Wall", + "", + "FLEX = flex", + "FLEX_OPTS = -P" ++ name, + "", + "BISON = bison", + "BISON_OPTS = -t -p" ++ name, + "", + "LATEX = pdflatex", + "", + "all: Test" ++ name ++ " " ++ name ++ ".pdf", + "", + ".PHONY: clean distclean", + "", + "clean:", + -- peteg: don't nuke what we generated - move that to the "vclean" target. + "\trm -f *.o " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".pdf Test" ++ name, + "", + "distclean: clean", -- FIXME + "\trm -f *.o Absyn.c Absyn.h Test.c Parser.c Parser.h Lexer.c Skeleton.c Skeleton.h Printer.c Printer.h " ++ name ++ ".l " ++ name ++ ".y " ++ name ++ ".tex " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".pdf Test" ++ name ++ " Makefile", + "", + "Test" ++ name ++ ": Absyn.o Lexer.o Parser.o Printer.o Test.o", + "\t@echo \"Linking test" ++ name ++ "...\"", + "\t${CC} ${CCFLAGS} *.o -o Test" ++ name ++ "", + "", + "Absyn.o: Absyn.c Absyn.h", + "\t${CC} ${CCFLAGS} -c Absyn.c", + "", + "Lexer.c: " ++ name ++ ".l", + "\t${FLEX} ${FLEX_OPTS} -oLexer.c " ++ name ++ ".l", + "", + "Parser.c: " ++ name ++ ".y", + "\t${BISON} ${BISON_OPTS} " ++ name ++ ".y -o Parser.c", + "", + "Lexer.o: Lexer.c Parser.h", + "\t${CC} ${CCFLAGS} -c Lexer.c ", + "", + "Parser.o: Parser.c Absyn.h", + "\t${CC} ${CCFLAGS} -c Parser.c", + "", + "Printer.o: Printer.c Printer.h Absyn.h", + "\t${CC} ${CCFLAGS} -c Printer.c", + "", + "Test.o: Test.c Parser.h Printer.h Absyn.h", + "\t${CC} ${CCFLAGS} -c Test.c", + "", + "" ++ name ++ ".pdf: " ++ name ++ ".tex", + "\t${LATEX} " ++ name ++ ".tex", + "" + ] ctest :: CF -> String ctest cf = diff --git a/src/formats/haskell-gadt/HaskellTopGADT.hs b/src/formats/haskell-gadt/HaskellTopGADT.hs --- a/src/formats/haskell-gadt/HaskellTopGADT.hs +++ b/src/formats/haskell-gadt/HaskellTopGADT.hs @@ -40,8 +40,6 @@ import MkErrM import MkSharedString import Utils -import qualified Common.Makefile as Makefile -import qualified HaskellTop as Haskell import Data.Char import Data.Maybe (fromMaybe,maybe) @@ -99,41 +97,46 @@ in pref ++ sep ++ dir makefile :: Options -> String -makefile = Haskell.makefile --- makefile opts = makeA where --- glr_params = if glr opts == GLR then "--glr --decode " else "" --- dir = let d = codeDir opts in if null d then "" else d ++ [pathSep] --- cd c = if null dir then c else "(cd " ++ dir ++ "; " ++ c ++ ")" ---- makeA = Makefile.mkRule "all" [] --- [ "happy -gca " ++ glr_params ++ happyFile opts ---- , "alex -g " ++ alexFile opts --- , "ghc --make " ++ tFile opts ++ " -o " ++ mkFile withLang "Test" "" opts] --- $ Makefile.mkDoc (basename (latexFile opts)) --- $ Makefile.mkRule "clean" [] --- [ "-rm -f " ++ unwords --- (map (dir++) [ "*.log", "*.aux", "*.hi", "*.o", "*.dvi" ]) --- , "-rm -f " ++ psFile opts ] --- $ 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 --- , dir ++ lang opts ++ ".dtd" --- , mkFile withLang "XML" "*" opts --- , "Makefile*" --- , mkFile withLang "ComposOp" "*" opts --- , dir ++ lang opts ++ ".dtd" --- , mkFile withLang "XML" "*" opts ] --- , if null dir then "" else "\t-rmdir -p " ++ dir ] --- "" +makefile opts = makeA where + glr_params = if glr opts == GLR then "--glr --decode " else "" + dir = let d = codeDir opts in if null d then "" else d ++ [pathSep] + cd c = if null dir then c else "(cd " ++ dir ++ "; " ++ c ++ ")" + makeA = unlines + [ + "all:", + "\thappy -gca " ++ glr_params ++ happyFile opts, + "\talex -g " ++ alexFile opts, + "\t" ++ cd ("latex " ++ basename (latexFile opts) + ++ "; " ++ "dvips " ++ basename (dviFile opts) + ++ " -o " ++ basename (psFile opts)), + "\tghc --make " ++ tFile opts ++ " -o " ++ mkFile withLang "Test" "" opts, + "clean:", + "\t-rm -f " ++ unwords (map (dir++) [ + "*.log", "*.aux", "*.hi", + "*.o", "*.dvi" + ]), + "\t-rm -f " ++ psFile opts, + + "distclean: clean", + "\t-rm -f " ++ unwords [ + mkFile withLang "Doc" "*" opts, + mkFile withLang "Lex" "*" opts, + mkFile withLang "Par" "*" opts, + mkFile withLang "Layout" "*" opts, + mkFile withLang "Skel" "*" opts, + mkFile withLang "Print" "*" opts, + mkFile withLang "Test" "*" opts, + mkFile withLang "Abs" "*" opts, + mkFile withLang "ComposOp" "*" opts, + mkFile withLang "Test" "" opts, + mkFile noLang "ErrM" "*" opts, + mkFile noLang "SharedString" "*" opts, + dir ++ lang opts ++ ".dtd", + mkFile withLang "XML" "*" opts, + "Makefile*" + ], + if null dir then "" else "\t-rmdir -p " ++ dir + ] testfile :: Options -> CF -> String diff --git a/src/formats/haskell2/CFtoAlex3.hs b/src/formats/haskell2/CFtoAlex3.hs --- a/src/formats/haskell2/CFtoAlex3.hs +++ b/src/formats/haskell2/CFtoAlex3.hs @@ -43,7 +43,6 @@ "-- This Alex file was machine-generated by the BNF converter", "{", "{-# OPTIONS -fno-warn-incomplete-patterns #-}", - "{-# OPTIONS_GHC -w #-}", "module " ++ name ++ " where", "", -- "import " ++ errMod, diff --git a/src/formats/haskell2/HaskellTop.hs b/src/formats/haskell2/HaskellTop.hs --- a/src/formats/haskell2/HaskellTop.hs +++ b/src/formats/haskell2/HaskellTop.hs @@ -17,7 +17,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -module HaskellTop (makeAll, AlexMode(..), makefile) where +module HaskellTop (makeAll, AlexMode(..)) where @@ -40,12 +40,11 @@ import MkErrM import MkSharedString import Utils -import qualified Common.Makefile as Makefile import Data.Char import Data.Maybe (fromMaybe,maybe) import System.Exit (exitFailure) -import Control.Monad(when,unless) +import Control.Monad(when) -- naming conventions @@ -63,7 +62,7 @@ shareMod = shareFileM opts do let dir = codeDir opts - unless (null dir) $ do + when (not (null dir)) $ do putStrLn $ "Creating directory " ++ dir prepareDir dir writeFileRep (absFile opts) $ cf2Abstract (byteStrings opts) absMod cf @@ -109,35 +108,43 @@ glr_params = if glr opts == GLR then "--glr --decode " else "" dir = let d = codeDir opts in if null d then "" else d ++ [pathSep] cd c = if null dir then c else "(cd " ++ dir ++ "; " ++ c ++ ")" - makeA = Makefile.mkRule "all" [] - [ "happy -gca " ++ glr_params ++ happyFile opts - , "alex -g " ++ alexFile opts - , "ghc --make " ++ tFile opts ++ " -o " ++ mkFile withLang "Test" "" opts] - $ Makefile.mkDoc (basename (latexFile opts)) - $ Makefile.mkRule "clean" [] - [ "-rm -f " ++ unwords - (map (dir++) [ "*.log", "*.aux", "*.hi", "*.o", "*.dvi" ]) - , "-rm -f " ++ psFile opts ] - $ 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 withLang "ComposOp" "*" opts - , dir ++ lang opts ++ ".dtd" - , mkFile withLang "XML" "*" opts - , "Makefile*" ] - , if null dir then "" else "\t-rmdir -p " ++ dir ] - "" + makeA = unlines + [ + "all:", + "\thappy -gca " ++ glr_params ++ happyFile opts, + "\talex -g " ++ alexFile opts, + "\t" ++ cd ("latex " ++ basename (latexFile opts) + ++ "; " ++ "dvips " ++ basename (dviFile opts) + ++ " -o " ++ basename (psFile opts)), + "\tghc --make " ++ tFile opts ++ " -o " ++ mkFile withLang "Test" "" opts, + "clean:", + "\t-rm -f " ++ unwords (map (dir++) [ + "*.log", "*.aux", "*.hi", + "*.o", "*.dvi" + ]), + "\t-rm -f " ++ psFile opts, + "distclean: clean", + "\t-rm -f " ++ unwords [ + mkFile withLang "Doc" "*" opts, + mkFile withLang "Lex" "*" opts, + mkFile withLang "Par" "*" opts, + mkFile withLang "Layout" "*" opts, + mkFile withLang "Skel" "*" opts, + mkFile withLang "Print" "*" opts, + mkFile withLang "Test" "*" opts, + mkFile withLang "Abs" "*" opts, + mkFile withLang "Test" "" opts, + mkFile noLang "ErrM" "*" opts, + mkFile noLang "SharedString" "*" opts, + dir ++ lang opts ++ ".dtd", + mkFile withLang "XML" "*" opts, + "Makefile*" + ], + if null dir then "" else "\t-rmdir -p " ++ dir + ] + + testfile :: Options -> CF -> String testfile opts cf = let lay = hasLayout cf @@ -154,15 +161,14 @@ "", "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 lay then ("import " ++ layoutFileM opts) else "", + if use_xml then ("import " ++ xmlFileM opts) else "", if_glr "import Data.FiniteMap(FiniteMap, lookupFM, fmToList)", if_glr "import Data.Maybe(fromJust)", "import " ++ errFileM opts, @@ -211,13 +217,11 @@ , " 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" ] run_glr @@ -274,4 +278,3 @@ , " dec_fn f = decode (find f) r" , " in GLR_Result (\\ff -> dec_fn $ ff f) (dec_fn f)" ] - diff --git a/src/formats/haskell2/HsOpts.hs b/src/formats/haskell2/HsOpts.hs deleted file mode 100644 --- a/src/formats/haskell2/HsOpts.hs +++ /dev/null @@ -1,78 +0,0 @@ -module HsOpts where - -import Utils -import Options - -type Options = SharedOptions - -alex1 opts = alexMode opts == Alex1 - -absFile, absFileM, alexFile, alexFileM, dviFile, - composOpFile, composOpFileM, - gfAbs, gfConc, - happyFile, happyFileM, - latexFile, errFile, errFileM, - templateFile, templateFileM, - printerFile, printerFileM, - layoutFile, layoutFileM, - psFile, tFile, tFileM :: Options -> String -absFile = mkFile withLangAbs "Abs" "hs" -absFileM = mkMod withLangAbs "Abs" -alexFile = mkFile withLang "Lex" "x" -alexFileM = mkMod withLang "Lex" -happyFile = mkFile withLang "Par" "y" -happyFileM = mkMod withLang "Par" -latexFile = mkFile withLang "Doc" "tex" -txtFile = mkFile withLang "Doc" "txt" -templateFile = mkFile withLang "Skel" "hs" -templateFileM = mkMod withLang "Skel" -printerFile = mkFile withLang "Print" "hs" -printerFileM = mkMod withLang "Print" -dviFile = mkFile withLang "Doc" "dvi" -psFile = mkFile withLang "Doc" "ps" -gfAbs = mkFile withLangAbs "" "Abs.gf" -gfConc = mkFile withLang "" "Conc.gf" -tFile = mkFile withLang "Test" "hs" -tFileM = mkMod withLang "Test" -errFile = mkFile noLang "ErrM" "hs" -errFileM = mkMod noLang "ErrM" -shareFile = mkFile noLang "SharedString" "hs" -shareFileM = mkMod noLang "SharedString" -layoutFileM = mkMod withLang "Layout" -layoutFile = mkFile withLang "Layout" "hs" -cnfTablesFile = mkFile withLang "CnfTables" "hs" -cnfTablesFileM= mkMod withLang "CnfTables" -xmlFileM = mkMod withLang "XML" -composOpFile = mkFile noLang "ComposOp" "hs" -composOpFileM = mkMod noLang "ComposOp" - - -noLang :: Options -> String -> String -noLang _ name = name - -withLang :: Options -> String -> String -withLang opts name = name ++ lang opts - -withLangAbs :: Options -> String -> String -withLangAbs opts name = postp $ name ++ lang opts - where - postp nam = if multi opts - then takeWhile (/='_') nam - else nam - -pkgToDir :: String -> FilePath -pkgToDir s = replace '.' pathSep s - - -mkMod :: (Options -> String -> String) -> String -> Options -> String -mkMod addLang name opts = - pref ++ if inDir opts then lang opts ++ "." ++ name else addLang opts name - where pref = maybe "" (++".") (inPackage opts) - -mkFile :: (Options -> String -> String) -> String -> String -> Options -> FilePath -mkFile addLang name ext opts = - pref ++ if inDir opts - then lang opts ++ [pathSep] ++ name ++ ext' - else addLang opts name ++ if null ext then "" else ext' - where pref = maybe "" (\p->pkgToDir p++[pathSep]) (inPackage opts) - ext' = if null ext then "" else "." ++ ext diff --git a/src/formats/haskell2/ToCNF.hs b/src/formats/haskell2/ToCNF.hs deleted file mode 100644 --- a/src/formats/haskell2/ToCNF.hs +++ /dev/null @@ -1,473 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -{- - Copyright (C) 2012 Authors: - Jean-Philippe Bernardy. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --} - -{-# LANGUAGE OverloadedStrings #-} - -module ToCNF (generate, genTestFile, genBenchmark) where - -{- - -Construction of CYK tables. The algorithm follows: - -Lange, Martin; Leiß, Hans (2009), "To CNF or not to CNF? An Efficient -Yet Presentable Version of the CYK Algorithm", Informatica Didactica - --} - -import CF hiding (App,Exp) -import HsOpts -import Control.Monad -import Control.Monad.RWS -import Control.Applicative hiding (Const) -import qualified Data.Map as M -import Data.List (nub,intercalate,sortBy,sort) -import Data.Maybe (maybeToList) -import Data.Function (on) -import Data.Char (isAlphaNum,ord) -import Data.String -import Data.Pair -import Text.PrettyPrint.HughesPJ hiding (first,(<>)) - -(f *** g) (a,b) = (f a, g b) -second g = id *** g - -onRules f (CFG (exts,rules)) = CFG (exts,f rules) - -toCNF cf0 = (cf1,cf2,units,descriptions) - where cf01@(CFG (exts01,_)) = funToExp . onRules delInternal $ cf0 - (rules',descriptions) = toBin (rulesOfCF cf01) - cf1 = CFG (exts01,rules') - cf2 = delNull cf1 - units = unitSet cf2 - -funToExp :: CFG Fun -> CFG Exp -funToExp = fmap toExp - -delInternal = filter (not . isInternalRhs . rhsRule) - where isInternalRhs (Left c:_) = c == internalCat - isInternalRhs _ = False - --------------------------------------------------------------- --- BIN: make sure no rule has more than 2 symbols on the rhs - -allocateCatName = do - n <- get - put (1+n) - return $ show n - -toBin :: [Rul Exp] -> ([Rul Exp], CatDescriptions) -toBin cf = (a,w) - where (a,_,w) = runRWS (concat <$> forM cf toBinRul) () 0 - -type CatDescriptions = M.Map Cat Doc - --- | Convert a rule into a number of equivalent rules with at most 2 --- symbols on the rhs. --- Also writes an explanation of what new categories are. -toBinRul :: Rul Exp -> RWS () CatDescriptions Int [Rul Exp] -toBinRul (Rule f cat rhs) | length rhs > 2 = do - cat' <- allocateCatName - r' <- toBinRul $ Rule f cat' p - tell $ M.singleton cat' (int (length p) <> "-prefix of " <> prettyExp f <> " " <> parens (prettyRHS p)) - return $ Rule (Con "($)") cat [Left cat',l] - : r' - where l = last rhs - p = init rhs - fun' = case l of - Left _ -> Con "($)" -- in this case we have to apply the final argument to the partial result - Right _ -> Con "const" -- in this case the 2nd argument must be ignored (it is not present in the result). -toBinRul r = return [r] - -prettyRHS = hcat . punctuate " " . map (either text (quotes . text)) - ---------------------------- --- Fixpoint utilities - -x ∪ y = sort $ nub (x ++ y) - -lk cat nullset = maybe [] id (M.lookup cat nullset) - -type Set k x = M.Map k [x] - -fixpointOnGrammar :: (Show k, Show x,Ord k, Ord x) => String -> (Set k x -> Rul f -> Set k x) -> CFG f -> Set k x -fixpointOnGrammar name f cf = case fixn 100 step M.empty of - Left x -> error $ "Could not find fixpoint of " ++ name ++". Last iteration:\n" ++ show x - Right x -> x - where step curSet = M.unionsWith (∪) (map (f curSet) (rulesOfCF cf)) - -fixn :: Eq a => Int -> (a -> a) -> a -> Either a a -fixn 0 f x = Left x -fixn n f x = if x' == x then Right x else fixn (n-1) f x' - where x' = f x - -------------------------------------------------------- --- DEL : make sure no rule has 0 symbol on the rhs - -type Nullable = Set Cat Exp - -cross :: [[a]] -> [[a]] -cross [] = [[]] -cross (x:xs) = [y:ys | y <- x, ys <- cross xs] - -nullRule :: Nullable -> Rul Exp -> (Cat,[Exp]) -nullRule nullset (Rule f c rhs) = (c, map (\xs -> (appMany f xs)) (cross (map nulls rhs))) - where nulls (Right tok) = [] - nulls (Left cat) = lk cat nullset - -nullable :: Nullable -> Rul Exp -> Bool -nullable s = not . null . snd . nullRule s - -nullSet :: CFG Exp -> Nullable -nullSet = fixpointOnGrammar "nullable" (\s r -> uncurry M.singleton (nullRule s r)) - --- | Replace nullable occurences by nothing, and adapt the function consequently. -delNullable :: Nullable -> Rul Exp -> [Rul Exp] -delNullable nullset r@(Rule f cat rhs) = case rhs of - [] -> [] - [_] -> [r] - [r1,r2] -> [r] ++ [Rule (app' f x) cat [r2] | x <- lk' r1] - ++ [Rule (app2 (isCat r1) f x) cat [r1] | x <- lk' r2] - _ -> error $ "Panic:" ++ show r ++ "should have at most two elements." - where lk' (Right tok) = [] - lk' (Left cat) = lk cat nullset - - -delNull cf = onRules (concatMap (delNullable (nullSet cf))) cf - - ---------------- --- UNIT - -type UnitRel cat = Set (Either cat String) (Exp,cat) - --- (c,(f,c')) ∈ unitSet ⇒ f : c → c' - -unitSet :: CFG Exp -> UnitRel Cat -unitSet = fixpointOnGrammar "unit set" unitRule - -unitRule unitSet (Rule f c [r]) = M.singleton r $ (f,c) : [(g `appl` f,c') | (g,c') <- lk (Left c) unitSet] - where appl = case r of - Left _ -> after - Right _ -> app' -unitRule _ _ = M.empty - -isUnitRule (Rule f c [r]) = True -isUnitRule _ = False - - ------------------------- --- Left/Right occurences - -isOnLeft, isOnRight :: RHSEl -> Rul f -> Bool -isOnLeft c (Rule f _ [c',_]) = c == c' -isOnLeft _ _ = False - -isOnRight c (Rule f _ [_,c']) = c == c' -isOnRight _ _ = False - -isEntryPoint cf el = either (`elem` allEntryPoints cf) (const False) el - -occurs :: (RHSEl -> Rul f -> Bool) -> RHSEl -> CFG f -> Bool -occurs where_ el cf = any (where_ el) (rulesOfCF cf) - -splitLROn :: (a -> RHSEl) -> CFG f -> [a] -> Pair [a] -splitLROn f cf xs = filt <*> pure xs - where filt = filter (\c -> occurs isOnLeft (f c) cf || isEntryPoint cf (f c)) :/: - filter (\c -> occurs isOnRight (f c) cf) - -isSpecial (Left ('@':'@':_)) = True -isSpecial _ = False - -optim :: (a -> RHSEl) -> Pair [a] -> Pair [(a,Doc -> Doc)] -optim f (x:/:y) = map modif x :/: map modif' y - where modif a | isSpecial (f a) = (a,\x -> "(if not p then (" <> x <> ":) else id)") - | otherwise = (a,rob) - modif' a | isSpecial (f a) = (a,\x -> "(if p then (" <> x <> ":) else id)") - | otherwise = (a,rob) - rob x = "("<> x <> ":)" - - -splitOptim f cf xs = optim f $ splitLROn f cf $ xs - - ---------------------------- --- Error reporting - --- leftOf C = ⋃ { {X} ∪ leftOf X | C ::= X B ∈ Grammar or C ::= X ∈ Grammar } -leftRight pos s (Rule f c rhs) = M.singleton c (lkCat x s) - where x = pos rhs - -lkCat (Right t) s = [Right t] -lkCat (Left c) s = Left c:lk c s - --- neighbors A B = ∃ A' B'. A ∈ rightOf A' ∧ B ∈ leftOf B -neighborSet cf = map (second (nub . sort)) $ group' [(x',lkCat y leftSet) | Rule _ _ [x,y] <- rulesOfCF cf, x' <- lkCat x rightSet] - where leftSet = fixpointOnGrammar "left set" (leftRight head) cf - rightSet = fixpointOnGrammar "right set" (leftRight last) cf - -genNeighborSet cf = vcat - ["neighbors " <> catTag x <> " = " <> ppList (map catTag y) - | (x,y) <- neighborSet cf] $$ - "neighbors _ = []" - -ppList = brackets . punctuate' ", " - -------------------------- --- Code generation - -incomment x = "{-" <> x <> "-}" - -generate opts cf0 = render $ vcat [header opts - ,genShowFunction cf0 - ,genCatTags cf1 - ,genDesc cf1 descriptions - ,genNeighborSet cf1 - ,genCombTable units (onRules (filter (not . isUnitRule)) cf) - ,genTokTable units cf - ,incomment $ vcat - ["Normalised grammar:" - ,text $ show cf - ,"Unit relation:" - ,prettyUnitSet units - ] - ] - where (cf1,cf,units,descriptions) = toCNF cf0 - -class Pretty a where - pretty :: a -> Doc - -instance (Pretty k, Pretty v) => Pretty (Set k v) where - pretty s = sep [pretty k <> " --> " <> pretty v | (k,x) <- M.assocs s, v <- x] - -instance Pretty (Either Cat String) where - pretty (Left x) = text x - pretty (Right x) = quotes $ text x - -instance Pretty String where - pretty = text - -prettyUnitSet units = vcat [prettyExp f <> " : " <> catTag cat <> " --> " <> text cat' | (cat,x) <- M.assocs units, (f,cat') <- x] - -header opts - = vcat ["{-# LANGUAGE MagicHash, FlexibleInstances #-}" - ,"module " <> text (cnfTablesFileM opts) <> " where" - ,"import GHC.Prim" - ,"import GHC.Exts" - ,"import Control.Applicative hiding (Const)" - ,"import Algebra.RingUtils" - ,"import Parsing.Chart ()" - ,"import " <> text (absFileM opts) - ,"import " <> text (alexFileM opts) - ,"import " <> text ( printerFileM opts) - ,"readInteger :: String -> Integer" - ,"readInteger = read" - ,"readDouble :: String -> Double" - ,"readDouble = read" - ,"instance RingP [(CATEGORY,Any)] where" - ," mul p a b = trav [map (app tx ty) l :/: map (app tx ty) r | (x,tx) <- a, (y,ty) <- b, let l:/:r = combine p x y]" - ," where trav :: [Pair [a]] -> Pair [a]" - ," trav [] = pure []" - ," trav (x:xs) = (++) <$> x <*> trav xs" - ," app tx ty (z,f) = (z, f tx ty)" - ] - -punctuate' p = cat . punctuate p - -genShowFunction cf = hang "showAst (cat,ast) = case cat of " 6 - (vcat [catTag (Left cat) <> " -> printTree ((unsafeCoerce# ast)::" <> text cat <> ")" - | cat <- filter isDataCat $ allCats cf] $$ - "_ -> \"Unprintable category\"") - - -genCatTags :: CFG Exp -> Doc -genCatTags cf = "data CATEGORY = " <> punctuate' "|" (map catTag (allSyms cf)) $$ - " deriving (Eq,Ord,Show)" - -genDesc :: CFG Exp -> CatDescriptions -> Doc -genDesc cf descs = vcat ["describe " <> catTag s <> " = " <> doubleQuotes (descOf s) | s <- allSyms cf] - where descOf (Right x) = "token " <> text x - descOf (Left x) = maybe (text x) id $ M.lookup x descs - - - -genCombTable :: UnitRel Cat -> CFG Exp -> Doc -genCombTable units cf = - "combine :: Bool -> CATEGORY -> CATEGORY -> Pair [(CATEGORY, Any -> Any -> Any)]" - $$ genCombine units cf - $$ "combine _ _ _ = pure []" - -allSyms :: CFG Exp -> [Either String String] -allSyms cf = map Left (allCats cf ++ literals cf) ++ map (Right . fst) (cfTokens cf) - - -ppPair (x,y) = parens $ x <> comma <> " " <> y - -unsafeCoerce' = app' (Con "unsafeCoerce#") - -type RHSEl = Either Cat String - -isCat (Right _) = False -isCat (Left _) = True - -group0 :: Eq a => [(a,[b])] -> [(a,[b])] -group0 [] = [] -group0 ((a,bs):xs) = (a,bs ++ concatMap snd ys) : group0 zs - where (ys,zs) = span (\x -> fst x == a) xs - -group' :: Ord a => [(a,[b])] -> [(a,[b])] -group' = group0 . sortBy (compare `on` fst) - -prettyPair (x :/: y) = sep [x,":/:",y] -prettyListFun xs = parens $ sep (map (<> "$") xs) <> "[]" - - -genCombine :: UnitRel Cat -> CFG Exp -> Doc -genCombine units cf = vcat $ map genEntry $ group' $ map (alt units) (rulesOfCF cf) - where genEntry :: ((RHSEl,RHSEl),[(Cat,Exp)]) -> Doc - genEntry ((r1,r2),cs) = "combine p " <> catTag r1 <> " " <> catTag r2 <> " = " <> prettyPair (genList <$> splitOptim (Left . fst) cf cs) - mkLam body = "\\x y -> " <> body - genList xs = prettyListFun [p (ppPair (catTag . Left $ x, mkLam . prettyExp . unsafeCoerce' $ y)) | ((x,y),p) <- xs] - -alt :: UnitRel Cat -> Rul Exp -> ((RHSEl,RHSEl),[(Cat,Exp)]) -alt units (Rule f c [r1,r2]) = ((r1,r2),initial:others) - where initial = (c, f `appMany` args) - others = [(c', f' `app'` (f `appMany` args)) | (f',c') <- lk (Left c) units] - args = map (unsafeCoerce' . Con) $ ["x"|isCat r1]++["y"|isCat r2] - - -catTag :: Either String String -> Doc -catTag (Left c) = "CAT_" <> text (concatMap escape c) -catTag (Right t) = "TOK_" <> text (concatMap escape t) - -escape c | isAlphaNum c || c == '_' = [c] -escape '[' = "" -escape ']' = "_List" -escape '{' = "OPEN_" -escape '}' = "CLOS_" -escape '@' = "BIN_" -escape c = show $ ord c - -genTokTable :: UnitRel Cat -> CFG Exp -> Doc -genTokTable units cf = "tokenToCats :: Bool -> Token -> Pair [(CATEGORY,Any)]" $$ - vcat (map (genSpecEntry cf units) (tokInfo cf)) $$ - vcat (map (genTokEntry cf units) (cfTokens cf)) $$ - "tokenToCats p t = error (\"unknown token: \" ++ show t)" - -tokInfo cf = ("Char","TC",Con "head"): - ("String","TL",Id):("Integer","TI",Con "readInteger"): - ("Double","TD",Con "readDouble"): - [("Ident","TV",Con "Ident")|hasIdent cf] ++ - [(t,"T_" <> text t,(Con t)) | t <- tokenNames cf] - -genTokCommon cf xs = prettyPair (gen <$> splitOptim fst cf xs) - where gen ys = prettyListFun [p (ppPair (catTag x,y)) | ((x,y),p) <- ys] - -genSpecEntry cf units (tokName,constrName,fun) = "tokenToCats p (PT (Pn _ l c) (" <> constrName <> " x)) = " <> genTokCommon cf xs - where xs = map (second (prettyExp . (\f -> unsafeCoerce' (f `app'` tokArgs)))) $ - (Left tokName, fun) : [(Left c,f `after` fun) | (f,c) <- lk (Left tokName) units] - tokArgs | isPositionCat cf tokName = Con "((l,c),x)" - | otherwise = Con "x" - -genTokEntry cf units (tok,x) = - " -- " <> text tok $$ - "tokenToCats p (PT posn (TS _ " <> int x <> ")) = " <> genTokCommon cf xs - where xs = (Right tok, tokVal) : - [(Left c,prettyExp (unsafeCoerce' f)) | (f,c) <- lk (Right tok) units] - tokVal = "error" <> (text $ show $ "cannot access value of token: " ++ tok) - ------------------------- --- Test file generation - -genTestFile opts cf = render $ vcat - ["module Main where" - ,"import " <> text ( alexFileM opts) - ,"import " <> text ( cnfTablesFileM opts) - ,"import Parsing.TestProgram" - ,"main = mainTest showAst tokenToCats tokens tokenLineCol describe neighbors"] - - -genBenchmark opts = render $ vcat - ["import System.Environment ( getArgs )" - ,"import "<> text ( alexFileM opts) <> " as Lexer" - ,"import "<> text ( cnfTablesFileM opts) <> " as Parser" - ,"import GHC.Exts" - ,"import Parsing.Chart" - ,"import Criterion.Main" - ,"import Algebra.RingUtils" - ,"import Control.Applicative" - ,"type T = [(CATEGORY,Any)]" - ,"pLGrammar :: [Pair T] -> MT2 T" - ,"pLGrammar = mkTree" - ,"main = do" - ," f:_ <- getArgs" - ," s <- readFile f" - ," let ts = zipWith tokenToCats (cycle [False,True]) (Lexer.tokens s)" - ," (ts1,x:ts2) = splitAt (length ts `div` 2) ts" - ," cs = [mkTree ts1,mkTree' ts2]" - ," work [c1,c2] = show $ map fst $ root $ mergein False c1 x c2" - ," defaultMain [bench f $ nf work cs] -- note the hack!!!" - ] - - - ---------------------------------- --- Management of expressions. - --- Most of this is not strictly useful; its main purpose is to --- generate "nice-looking" semantic actions - -data Exp = Id -- identity function - | Con String -- constructor or variable - | App Exp Exp - | Exp `After` Exp - | App2 Exp Exp - deriving (Eq,Ord) - -prettyExp Id = "id" -prettyExp (Con x) = text x -prettyExp (App f x) = prettyExp f <+> (parens $ prettyExp x) -prettyExp (App2 f x) = "flip" <+> parens (prettyExp f) <+> parens (prettyExp x) -prettyExp (f `After` g) = parens (prettyExp f) <> "." <> parens (prettyExp g) - -instance Show Exp where show = render . prettyExp - --- | Apply in 2nd position if the flag is true, otherwise apply normally. -app2 True f x = App2 f x -app2 False f x = app' f x - -infixl `app'` -app' :: Exp -> Exp -> Exp -app' (f `After` g) x = app' f (app' g x) -app' Id x = x -app' (App2 f y) x = (f `app'` x) `app'` y -app' (Con "($)") f = f --- app' (Con "const") f = f -app' f x = App f x - -toExp f | isCoercion f = Id - | otherwise = Con f - -after :: Exp -> Exp -> Exp -after Id f = f -after f Id = f -after f g = f `After` g - - -appMany f args = foldl app' f args diff --git a/src/formats/java1.5/JavaTop15.hs b/src/formats/java1.5/JavaTop15.hs --- a/src/formats/java1.5/JavaTop15.hs +++ b/src/formats/java1.5/JavaTop15.hs @@ -56,7 +56,7 @@ import CFtoLatex import Data.Char import Data.List(intersperse) -import qualified Common.Makefile as Makefile + ------------------------------------------------------------------- -- | Build the Java output. -- FIXME: get everything to put the files in the right places. @@ -122,62 +122,81 @@ -- Replace with an ANT script? makefile :: String -> FilePath -> FilePath -> [String] -> String makefile name dirBase dirAbsyn absynFileNames = - (++) (unlines [ "JAVAC = javac", - "JAVAC_FLAGS = -sourcepath .", "", - "JAVA = java", - "JAVA_FLAGS =", "", - "CUP = java_cup.Main", - "CUPFLAGS = -nopositions -expect 100", "", - "JLEX = JLex.Main", "" ]) - $ 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" ] - [ "${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" ] - [] + unlines + [ + "JAVAC = javac", + "JAVAC_FLAGS = -sourcepath .", + "", + "JAVA = java", + "JAVA_FLAGS =", + "", + "CUP = java_cup.Main", + "CUPFLAGS = -nopositions -expect 100", + "", + "JLEX = JLex.Main", + "", + "LATEX = latex", + "DVIPS = dvips", + "", + "all: test " ++ name ++ ".ps", + "", + "test: absyn " + ++ unwords (map (dirBase ++) [ + "Yylex.class", + "PrettyPrinter.class", + "Test.class", + "ComposVisitor.class", + "AbstractVisitor.class", + "FoldVisitor.class", + "AllVisitor.class", + "parser.class", + "sym.class", + "Test.class"]), + "", + ".PHONY: absyn", + "", + "%.class: %.java", + "\t${JAVAC} ${JAVAC_FLAGS} $^", + "", + "absyn: " ++ absynJavaSrc, + "\t${JAVAC} ${JAVAC_FLAGS} $^", + "", + dirBase ++ "Yylex.java: " ++ dirBase ++ "Yylex", + "\t${JAVA} ${JAVA_FLAGS} ${JLEX} " ++ dirBase ++ "Yylex", + "", + dirBase ++ "sym.java " ++ dirBase ++ "parser.java: " ++ dirBase ++ name ++ ".cup", + "\t${JAVA} ${JAVA_FLAGS} ${CUP} ${CUPFLAGS} " ++ dirBase ++ name ++ ".cup", + "\tmv sym.java parser.java " ++ dirBase, + "", + dirBase ++ "Yylex.class: " ++ dirBase ++ "Yylex.java" + ++ " " ++ dirBase ++ "sym.java", + "", + dirBase ++ "sym.class: " ++ dirBase ++ "sym.java", + "", + dirBase ++ "parser.class: " ++ dirBase ++ "parser.java " ++ dirBase ++ "sym.java", + "", + dirBase ++ "PrettyPrinter.class: " ++ dirBase ++ "PrettyPrinter.java", + "", + "" ++ name ++ ".dvi: " ++ name ++ ".tex", + "\t${LATEX} " ++ name ++ ".tex", + "", + "" ++ name ++ ".ps: " ++ name ++ ".dvi", + "\t${DVIPS} " ++ name ++ ".dvi -o " ++ name ++ ".ps", -- FIXME - $ Makefile.mkRule "clean" [] - [ "rm -f " ++ dirAbsyn ++ "*.class" ++ " " ++ dirBase ++ "*.class" - , "rm -f " ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps " ++ " *.class" ] - $ Makefile.mkRule "distclean" [ "vclean" ] - [] - $ Makefile.mkRule "vclean" [] - [ " rm -f " ++ absynJavaSrc ++ " " ++ absynJavaClass - , " rm -f " ++ dirAbsyn ++ "*.class" --- , "rm -f " ++ "Test" ++ name - , " rmdir " ++ dirAbsyn - , " rm -f " ++ name ++ ".tex " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps " - , " rm -f " ++ unwords (map (dirBase ++) [ + "", + "clean:", + "\t rm -f " ++ dirAbsyn ++ "*.class" ++ " " ++ dirBase ++ "*.class", + "\t rm -f " ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps " ++ " *.class", + "", + "distclean: vclean", + "", + "vclean:", + "\t rm -f " ++ absynJavaSrc ++ " " ++ absynJavaClass, + "\t rm -f " ++ dirAbsyn ++ "*.class", +--- "\t rm -f " ++ "Test" ++ name, + "\t rmdir " ++ dirAbsyn, + "\t rm -f " ++ name ++ ".tex " ++ name ++ ".dvi " ++ name ++ ".aux " ++ name ++ ".log " ++ name ++ ".ps ", + "\t rm -f " ++ unwords (map (dirBase ++) [ "Yylex", name ++ ".cup", "Yylex.java", @@ -191,10 +210,11 @@ "Test.java", "sym.java", "parser.java", - "*.class"]) - , "rm -f Makefile" - , "rmdir -p " ++ dirBase ] - "" + "*.class"]), + "\t rm -f Makefile", + "\t rmdir -p " ++ dirBase, + "" + ] where absynJavaSrc = unwords (map (++ ".java") absynFileNames) absynJavaClass = unwords (map (++ ".class") absynFileNames) diff --git a/test/src/system-tests-c.hs b/test/src/system-tests-c.hs deleted file mode 100644 --- a/test/src/system-tests-c.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ExtendedDefaultRules #-} -{-# OPTIONS_GHC -fno-warn-type-defaults #-} -module Main where - -import Filesystem.Path (basename) -import Filesystem.Path.CurrentOS (decodeString, encodeString) -import Text.Printf (printf) -import Shelly -import Prelude hiding (FilePath) -import Data.Text.Lazy (Text) -import Control.Exception (assert) -import Paths_BNFC -import SystemTesting (systemTestMain, Backend, assertExists) - -default (Text) - -cBackend :: Backend -cBackend bnfcBin cfFile testFile = - shelly $ print_commands True $ withTmpDir $ \temp -> do - cd temp - -- Preconditions: testing for the existence of the input files - assertExists cfFile - assertExists testFile - -- TODO test existance and executability of bnf - bnfc "-m" "-c" cfFile - make - -- Now we run the test programme, passing the content of - -- the test source file on stdin - -- Note that we don't print stdout because it can be very verbose - -- and we only rely on the status code returned by the test - -- program to decide if the test passes or fails - readfile testFile >>= setStdin - test - where make = cmd "make" - bnfc = cmd bnfcBin - testProg = decodeString ("Test" ++ (encodeString $ basename cfFile)) - test = cmd ("." testProg) - --- Main is defined in SystemTesting, we just pass our backend as a parameter -main = systemTestMain cBackend diff --git a/test/src/system-tests-haskell.hs b/test/src/system-tests-haskell.hs deleted file mode 100644 --- a/test/src/system-tests-haskell.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ExtendedDefaultRules #-} -{-# OPTIONS_GHC -fno-warn-type-defaults #-} -module Main where - -import Filesystem.Path (basename) -import Filesystem.Path.CurrentOS (decodeString, encodeString) -import Text.Printf (printf) -import Shelly -import Prelude hiding (FilePath) -import Data.Text.Lazy (Text) -import Control.Exception (assert) -import Paths_BNFC -import SystemTesting (systemTestMain, Backend, assertExists) - -default (Text) - -haskellBackend :: Backend -haskellBackend bnfcBin cfFile testFile = - shelly $ print_commands True $ withTmpDir $ \temp -> do - cd temp - -- Preconditions: testing for the existence of the input files - assertExists cfFile - assertExists testFile - -- TODO test existance and executability of bnf - bnfc "-m" "-haskell" cfFile - make - -- Now we run the test programme, passing the content of - -- the test source file on stdin - -- Note that we don't print stdout because it can be very verbose - -- and we only rely on the status code returned by the test - -- program to decide if the test passes or fails - readfile testFile >>= setStdin - test - where make = cmd "make" - bnfc = cmd bnfcBin - testProg = decodeString ("Test" ++ (encodeString $ basename cfFile)) - test = cmd ("." testProg) - --- Main is defined in SystemTesting, we just pass our backend as a parameter -main = systemTestMain haskellBackend diff --git a/test/src/system-tests-java.hs b/test/src/system-tests-java.hs deleted file mode 100644 --- a/test/src/system-tests-java.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ExtendedDefaultRules #-} -{-# OPTIONS_GHC -fno-warn-type-defaults #-} -module Main where - -import Filesystem.Path (basename) -import Filesystem.Path.CurrentOS (decodeString, encodeString) -import Text.Printf (printf) -import Shelly -import Prelude hiding (FilePath) -import Data.Text.Lazy (Text) -import Control.Exception (assert) -import Paths_BNFC -import SystemTesting (systemTestMain, Backend, assertExists) - -default (Text) - -javaBackend :: Backend -javaBackend bnfcBin cfFile testFile = - shelly $ print_commands True $ withTmpDir $ \temp -> do - cd temp - -- Preconditions: testing for the existence of the input files - assertExists cfFile - assertExists testFile - -- TODO test existance and executability of bnf - bnfc "-m" "-java" cfFile - make - -- Now we run the test programme, passing the content of - -- the test source file on stdin - -- Note that we don't print stdout because it can be very verbose - -- and we only rely on the status code returned by the test - -- program to decide if the test passes or fails - readfile testFile >>= setStdin - java testProg - where make = cmd "make" - bnfc = cmd bnfcBin - java = cmd "java" - testProg = basename cfFile "Test" - --- Main is defined in SystemTesting, we just pass our backend as a parameter -main = systemTestMain javaBackend - diff --git a/test/src/unit-tests.hs b/test/src/unit-tests.hs deleted file mode 100644 --- a/test/src/unit-tests.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Main where - -import Test.HUnit -import Test.Framework (defaultMain, testGroup) -import Test.Framework.Providers.HUnit - -import qualified Common.Makefile as Makefile - -main = defaultMain tests - -tests = - [ testGroup "Makefile" - [ testCase "Simple make rule" testRule1 - , testCase "Rule without recipe" testRule2 - , testCase "Documentation rules" testDocRule]] - -testRule1 = "main: file1 file2\n\tdo something\n\n" - @=? Makefile.mkRule "main" ["file1","file2"] ["do something"] "" - -testRule2 = "main: program.exe\n\n" - @=? Makefile.mkRule "main" ["program.exe"] [] "" - -testDocRule = "doc: test.pdf\n\ntest.pdf: test.tex\n\tpdflatex test.tex\n\n" - @=? Makefile.mkDoc "test.tex" ""