diff --git a/BNFC.cabal b/BNFC.cabal --- a/BNFC.cabal +++ b/BNFC.cabal @@ -1,5 +1,5 @@ Name: BNFC -Version: 2.9.1.1 +Version: 2.9.2 cabal-version: 2.0 -- >=1.24 for the custom-setup section -- >=2.0 for the build-tools: hspec-discover @@ -27,61 +27,52 @@ a LaTeX file containing a readable specification of the language. tested-with: - GHC == 9.12.2 - GHC == 9.10.3 - GHC == 9.8.4 - GHC == 9.6.7 - GHC == 9.4.8 - 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 == 7.10.3 GHC == 8.0.2 - -- GHC == 7.10.3 + GHC == 8.2.2 + GHC == 8.4.4 + GHC == 8.6.5 + GHC == 8.8.4 + GHC == 8.10.4 + GHC == 9.0.1 -Extra-doc-files: +Extra-source-files: README.md CHANGELOG.md -- LICENSE is automatically included - -Extra-source-files: Makefile src/BNFC.cf src/Makefile - stack-9.12.yaml - stack-9.10.yaml - stack-9.8.yaml - stack-9.6.yaml - stack-9.4.yaml - stack-9.2.yaml - stack-9.0.yaml - stack-8.10.yaml - stack-8.8.yaml - stack-8.6.yaml - stack-8.4.yaml - stack-8.2.yaml + stack-9.0.1.yaml + stack-8.10.4.yaml + stack-8.10.3.yaml + stack-8.10.2.yaml + stack-8.8.4.yaml + stack-8.8.3.yaml + stack-8.8.2.yaml + stack-8.6.5.yaml + stack-8.6.4.yaml + stack-8.4.4.yaml + stack-8.2.2.yaml stack-8.0.2.yaml stack-7.10.3.yaml Source-repository head type: git - location: https://github.com/BNFC/bnfc.git + location: git://github.com/BNFC/bnfc.git subdir: source Source-repository this type: git - location: https://github.com/BNFC/bnfc.git + location: git://github.com/BNFC/bnfc.git subdir: source - tag: v2.9.1.1 + tag: v2.9.2 -- Setup using https://github.com/haskellari/cabal-doctest custom-setup setup-depends: - base >= 4 && < 5, - Cabal >= 2.0 && < 4, + base >= 4 && <5, + Cabal >= 2.0, cabal-doctest >= 1 && < 1.1 executable bnfc @@ -94,8 +85,6 @@ other-modules: -- Generated by cabal Paths_BNFC - autogen-modules: - Paths_BNFC default-extensions: -- Keep in alphabetical order. LambdaCase @@ -114,17 +103,18 @@ default-language: Haskell2010 build-depends: - base >=4.8 && < 5, - mtl >= 2.2.1, - directory, - array, - containers, - pretty >=1.1 && <1.2, - filepath, - deepseq, - string-qq, - time - if impl(ghc < 8) + base >= 4.8 && < 5 + , array + , containers + , deepseq + , directory + , filepath + , mtl >= 2.2.1 + , pretty >= 1.1 && < 1.2 + , process + , string-qq + , time + if impl(ghc < 8.0) build-depends: semigroups build-tool-depends: @@ -141,6 +131,7 @@ FlexibleContexts FlexibleInstances LambdaCase + MultiWayIf NamedFieldPuns OverloadedStrings PatternGuards @@ -159,8 +150,6 @@ other-modules: -- Generated by cabal Paths_BNFC - autogen-modules: - Paths_BNFC exposed-modules: -- Generated from LICENSE BNFC.License @@ -220,6 +209,7 @@ -- C backend BNFC.Backend.C + BNFC.Backend.C.Common BNFC.Backend.C.CFtoCPrinter BNFC.Backend.C.CFtoCSkel BNFC.Backend.C.CFtoBisonC @@ -228,17 +218,15 @@ BNFC.Backend.C.RegToFlex -- C++ backend + BNFC.Backend.CPP.Common BNFC.Backend.CPP.PrettyPrinter BNFC.Backend.CPP.Makefile BNFC.Backend.CPP.Naming BNFC.Backend.CPP.NoSTL - BNFC.Backend.CPP.NoSTL.CFtoFlex - BNFC.Backend.CPP.NoSTL.CFtoBison BNFC.Backend.CPP.NoSTL.CFtoCPPAbs -- C++ STL backend BNFC.Backend.CPP.STL - BNFC.Backend.CPP.STL.CFtoBisonSTL BNFC.Backend.CPP.STL.CFtoSTLAbs BNFC.Backend.CPP.STL.STLUtils BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL @@ -294,7 +282,7 @@ deepseq, string-qq, time - if impl(ghc < 8) + if impl(ghc < 8.0) build-depends: semigroups build-tool-depends: diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,9 +1,33 @@ -# 2.9.1.1 +# 2.9.2 -Andreas Abel Jan 2026 +Andreas Abel June 2021 -* Cabal 3.12 compatibility: remove generated `Lex.hs` and `Par.hs` from source tarball -* Build tested with GHC 7.10.3 - 9.12.2 +## Major improvements + +* Haskell: layout keywords can now be stacked on the same line [#354], + see https://bnfc.readthedocs.io/en/latest/lbnf.html#stacking-layout-keywords +* C: new methods `free_*` and `clone_*` to deallocate and clone syntax trees [#348] +* C/C++ backends now create reentrant parsers [#349] + +## Bug fixes and small improvements + +* Haskell-GADT: generated code is warning free [#346] +* Haskell: fixes in layout preprocessor [#343,#344,#345,#352,#353] +* Haskell: print `[Char]` correctly, removed method `prtList` [#359] +* Haskell: added missing import [#368], regression introduced in 2.9.1 by [#331] +* C: fixed a space leak when parsing from a string in memory [#347] +* C: removed errorneous `define`d constructors from `Skeleton.c` +* C++: `define`d constructors now reside in `Absyn` [#287] +* Java: `define`d constructor now reside in `AbsynDef.java` [#287] +* Ocaml: fixed translation of nested `define`d constructors +* C/C++/Java: Pre/post/mixfix lists are now printed correctly [#358] +* all: `define`d constructors involving list expressions work now [#363] +* all: printers render braces on their own line [#366] + +## Cosmetical changes + +* C/C++: instead of `_SYMB_nnn`, more readable token names in lexer & parser + # 2.9.1 diff --git a/src/BNFC/Abs.hs b/src/BNFC/Abs.hs --- a/src/BNFC/Abs.hs +++ b/src/BNFC/Abs.hs @@ -1,14 +1,18 @@ -- Haskell data types for the abstract syntax. -- Generated by the BNF converter. -module BNFC.Abs where +{-# LANGUAGE PatternSynonyms #-} -import Prelude (Char, Double, Int, Integer, String) -import qualified Prelude as C (Eq, Ord, Show, Read) +-- | The abstract syntax of language BNFC. -newtype Identifier = Identifier ((Int, Int), String) - deriving (C.Eq, C.Ord, C.Show, C.Read) +module BNFC.Abs where +import Prelude (Char, Double, Integer, String) +import qualified Prelude as C + ( Eq, Ord, Show, Read + , Int, Maybe(..) + ) + data Grammar = Grammar [Def] deriving (C.Eq, C.Ord, C.Show, C.Read) @@ -80,4 +84,25 @@ | RLower | RAny deriving (C.Eq, C.Ord, C.Show, C.Read) + +newtype Identifier = Identifier ((C.Int, C.Int), String) + deriving (C.Eq, C.Ord, C.Show, C.Read) + +-- | Start position (line, column) of something. + +type BNFC'Position = C.Maybe (C.Int, C.Int) + +pattern BNFC'NoPosition :: BNFC'Position +pattern BNFC'NoPosition = C.Nothing + +pattern BNFC'Position :: C.Int -> C.Int -> BNFC'Position +pattern BNFC'Position line col = C.Just (line, col) + +-- | Get the start position of something. + +class HasPosition a where + hasPosition :: a -> BNFC'Position + +instance HasPosition Identifier where + hasPosition (Identifier (p, _)) = C.Just p diff --git a/src/BNFC/Backend/Agda.hs b/src/BNFC/Backend/Agda.hs --- a/src/BNFC/Backend/Agda.hs +++ b/src/BNFC/Backend/Agda.hs @@ -1,3 +1,14 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} + +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} +#endif + -- | Agda backend. -- -- Generate bindings to Haskell data types for use in Agda. @@ -108,17 +119,6 @@ -- > {-# COMPILE GHC printDef = \ d -> Data.Text.pack (printTree (d :: CPP.Abs.Def)) #-} -- > {-# COMPILE GHC printProgram = \ p -> Data.Text.pack (printTree (p :: CPP.Abs.Program)) #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} - -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} -#endif - module BNFC.Backend.Agda (makeAgda) where import Prelude hiding ((<>)) @@ -143,8 +143,6 @@ import BNFC.PrettyPrint import BNFC.Utils (ModuleName, replace, when, table) -type List1 = List1.NonEmpty - -- | How to print the types of constructors in Agda? data ConstructorStyle @@ -331,25 +329,32 @@ -> Doc imports numeric layout pos = vcat . map prettyImport . concat $ [ when layout - [ ("Agda.Builtin.Bool", [("Bool", boolT)]) ] - , [ ("Agda.Builtin.Char", [("Char", charT)]) ] + [ ("Agda.Builtin.Bool", [], [("Bool", boolT)]) ] + , [ ("Agda.Builtin.Char", [charT], [] ) ] , when (numeric == YesImportNumeric) importNumeric - , [ ("Agda.Builtin.List", [("List", listT)]) ] + , [ ("Agda.Builtin.List", ["[]", "_∷_"], [("List", listT)]) ] , when pos - [ ("Agda.Builtin.Nat", [("Nat" , natT )]) ] - , [ ("Agda.Builtin.String", [("String", stringT), ("primStringFromList", stringFromListT) ]) ] + [ ("Agda.Builtin.Nat", [], [("Nat" , natT )]) ] + , [ ("Agda.Builtin.String", [], [("String", stringT), ("primStringFromList", stringFromListT) ]) ] ] where - importNumeric :: [(String, [(String, Doc)])] + importNumeric :: [(String, [Doc], [(String, Doc)])] importNumeric = - [ ("Agda.Builtin.Float public", [("Float", doubleT)]) - , ("Agda.Builtin.Int public", [("Int", integerT)]) + [ ("Agda.Builtin.Float public", [], [("Float", doubleT)]) + , ("Agda.Builtin.Int public", [], [("Int", integerT)]) + , ("Agda.Builtin.Int" , [], [("pos", "#pos")]) ] - prettyImport :: (String, [(String, Doc)]) -> Doc - prettyImport (m, ren) = prettyList 2 pre lparen rparen semi $ - map (\ (x, d) -> hsep [text x, "to", d ]) ren + prettyImport :: (String, [Doc], [(String, Doc)]) -> Doc + prettyImport (m, use, ren) + | null ren = pre + | otherwise = prettyList 2 pre lparen rparen semi $ + map (\ (x, d) -> hsep [text x, "to", d ]) ren where - pre = hsep [ "open", "import", text m, "using", "()", "renaming" ] + pre = hsep $ concat + [ [ "open", "import", text m ] + , [ "using", parens $ hcat $ punctuate "; " use ] + , [ "renaming" | not (null ren) ] + ] -- | Import Agda AST. -- @@ -462,7 +467,7 @@ -- prData :: ModuleName -> ConstructorStyle -> Data -> [Doc] prData amod style (Cat d, cs) = prData' amod style d cs -prData _ _ (c , _ ) = error $ "prData: unexpected category " ++ show c +prData _ _ (c , _ ) = error $ "prData: unexpected category " ++ prettyShow c -- | Pretty-print Agda data types and pragmas. -- @@ -649,23 +654,24 @@ -- | Generate Haskell code for the @define@d constructors. definedRules :: CF -> Doc -definedRules cf = vsep [ mkDef f xs e | FunDef f xs e <- cfgPragmas cf ] +definedRules cf = vsep $ map mkDef $ definitions cf where - mkDef f xs e = vcat $ map text $ concat - [ [ unwords [ mkDefName f, ":", typeToHaskell' "→" $ wpThing t ] + mkDef (Define f args e t) = vcat $ concat + [ [ text $ unwords [ mkDefName f, ":", typeToHaskell' "→" $ wpThing t ] | t <- maybeToList $ sigLookup f cf ] - , [ unwords $ concat - [ [ mkDefName f, "=", "λ" ] - , map agdaLower xs - , [ "→", show $ sanitize e ] + , [ hsep $ concat + [ [ text (mkDefName f), "=", "λ" ] + , map (text . agdaLower . fst) args + , [ "→", pretty $ sanitize e ] ] ] ] sanitize = \case - App x es -> App (agdaLower x) $ map sanitize es + App "(:)" t es-> App "_∷_" t $ map sanitize es + App x t es -> App (agdaLower x) t $ map sanitize es Var x -> Var $ agdaLower x - e@LitInt{} -> e + e@LitInt{} -> App "#pos" dummyType [e] e@LitDouble{} -> e e@LitChar{} -> e e@LitString{} -> e diff --git a/src/BNFC/Backend/C.hs b/src/BNFC/Backend/C.hs --- a/src/BNFC/Backend/C.hs +++ b/src/BNFC/Backend/C.hs @@ -32,9 +32,9 @@ mkfile "Absyn.c" cfile mkfile "Buffer.h" bufferH mkfile "Buffer.c" $ bufferC "Buffer.h" - let (flex, env) = cf2flex prefix cf + let (flex, env) = cf2flex parserMode cf mkfile (name ++ ".l") flex - let bison = cf2Bison (linenumbers opts) prefix cf env + let bison = cf2Bison (linenumbers opts) parserMode cf env mkfile (name ++ ".y") bison let header = mkHeaderFile (linenumbers opts) cf (Map.elems env) mkfile "Parser.h" header @@ -54,6 +54,8 @@ -- It should be a valid C identifier. prefix :: String prefix = snakeCase_ name ++ "_" + parserMode :: ParserMode + parserMode = CParser False prefix makefile :: String -> String -> String -> Doc @@ -86,6 +88,7 @@ , Makefile.mkRule "distclean" ["clean"] [ "rm -f " ++ unwords [ "Absyn.h", "Absyn.c" + , "Bison.h" , "Buffer.h", "Buffer.c" , name ++ ".l", "Lexer.c" , name ++ ".y", "Parser.h", "Parser.c" @@ -104,11 +107,11 @@ [ "${CC} ${CCFLAGS} -c Buffer.c" ] , Makefile.mkRule "Lexer.c" [ name ++ ".l" ] [ "${FLEX} ${FLEX_OPTS} -oLexer.c " ++ name ++ ".l" ] - , Makefile.mkRule "Parser.c" [ name ++ ".y" ] + , Makefile.mkRule "Parser.c Bison.h" [ name ++ ".y" ] [ "${BISON} ${BISON_OPTS} " ++ name ++ ".y -o Parser.c" ] - , Makefile.mkRule "Lexer.o" [ "Lexer.c", "Parser.h" ] + , Makefile.mkRule "Lexer.o" [ "Lexer.c", "Bison.h" ] [ "${CC} ${CCFLAGS} -c Lexer.c " ] - , Makefile.mkRule "Parser.o" ["Parser.c", "Absyn.h" ] + , Makefile.mkRule "Parser.o" ["Parser.c", "Absyn.h", "Bison.h" ] [ "${CC} ${CCFLAGS} -c Parser.c" ] , Makefile.mkRule "Printer.o" [ "Printer.c", "Printer.h", "Absyn.h" ] [ "${CC} ${CCFLAGS} -c Printer.c" ] @@ -187,6 +190,7 @@ " printf(\"[Linearized Tree]\\n\");", " printf(\"%s\\n\\n\", print" ++ dat ++ "(parse_tree));", " }", + " free_" ++ dat ++ "(parse_tree);", " return 0;", " }", " return 1;", @@ -208,52 +212,15 @@ , "" , "#include \"Absyn.h\"" , "" - , "typedef union" - , "{" ] - , map (" " ++) unionBuiltinTokens - , concatMap mkPointer $ allParserCatsNorm cf - , [ "} YYSTYPE;" - , "" - -- https://www.gnu.org/software/bison/manual/html_node/Location-Type.html#Location-Type - , "typedef struct YYLTYPE" - , "{" - , " int first_line;" - , " int first_column;" - , " int last_line;" - , " int last_column;" - , "} YYLTYPE;" - , "" - , "#define _ERROR_ 258" - , mkDefines (259::Int) env - , "" - , "extern YYLTYPE yylloc;" - , "extern YYSTYPE yylval;" - , "" - ] + -- Andreas, 2021-03-24 + -- Removed stuff that is now generated in Bison.h using the %defines pragma in the .y file. , concatMap mkFunc $ toList $ allEntryPoints cf , [ "" , "#endif" ] ] where - mkDefines n [] = mkString n - mkDefines n (s:ss) = ("#define " ++ s +++ (show n) ++ "\n") ++ (mkDefines (n+1) ss) - mkString n = if isUsedCat cf (TokenCat catString) - then ("#define _STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) - else mkChar n - mkChar n = if isUsedCat cf (TokenCat catChar) - then ("#define _CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) - else mkInteger n - mkInteger n = if isUsedCat cf (TokenCat catInteger) - then ("#define _INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) - else mkDouble n - mkDouble n = if isUsedCat cf (TokenCat catDouble) - then ("#define _DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) - else mkIdent n - mkIdent n = if isUsedCat cf (TokenCat catIdent) - then ("#define _IDENT_ " ++ show n ++ "\n") - else "" -- Andreas, 2019-04-29, issue #210: generate parsers also for coercions mkFunc c = [ identCat (normCat c) ++ " p" ++ identCat c ++ "(FILE *inp);" @@ -381,12 +348,9 @@ , " /* Make sure the buffer can hold all of s. */" , " bufferAllocateChars(buffer, len);" , "" - , " /* Append s at the end of the buffer. */" - , " strncpy(buffer->chars + buffer->current, s, len);" - , "" - , " /* Terminate with 0. */" + , " /* Append s at the end of the buffer, including terminating 0. */" + , " strncpy(buffer->chars + buffer->current, s, len + 1);" , " buffer->current += len;" - , " buffer->chars[buffer->current] = 0;" , " }" , "}" , "" diff --git a/src/BNFC/Backend/C/CFtoBisonC.hs b/src/BNFC/Backend/C/CFtoBisonC.hs --- a/src/BNFC/Backend/C/CFtoBisonC.hs +++ b/src/BNFC/Backend/C/CFtoBisonC.hs @@ -1,3 +1,9 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + {- BNF Converter: C Bison generator Copyright (C) 2004 Author: Michael Pellauer @@ -11,29 +17,31 @@ Created : 6 August, 2003 -} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE TupleSections #-} - module BNFC.Backend.C.CFtoBisonC ( cf2Bison - , mkPointer , resultName, typeName, varName , specialToks, startSymbol , unionBuiltinTokens ) where -import Data.Char (toLower) -import Data.Foldable (toList) -import Data.List (intercalate, nub) -import Data.Maybe (fromMaybe) +import Prelude hiding ((<>)) + +import Data.Char ( toLower, isUpper ) +import Data.Foldable ( toList ) +import Data.List ( intercalate, nub ) +import Data.Maybe import qualified Data.Map as Map +import System.FilePath ( (<.>) ) import BNFC.CF import BNFC.Backend.Common.NamedVariables hiding (varName) -import BNFC.Options (RecordPositions(..)) -import BNFC.Utils ((+++)) +import BNFC.Backend.C.CFtoFlexC (ParserMode(..), cParser, stlParser, parserHExt, parserName, parserPackage) +import BNFC.Backend.CPP.Naming +import BNFC.Backend.CPP.STL.STLUtils +import BNFC.Options (RecordPositions(..), InPackage) +import BNFC.PrettyPrint +import BNFC.Utils ((+++), table, applyWhen, for, unless, when, whenJust) --This follows the basic structure of CFtoHappy. @@ -44,171 +52,265 @@ type MetaVar = String --The environment comes from the CFtoFlex -cf2Bison :: RecordPositions -> String -> CF -> SymMap -> String -cf2Bison rp name cf env = unlines - [ header name cf - , union (allParserCatsNorm cf) - , "%token _ERROR_" - , tokens (map fst $ tokenPragmas cf) env - , declarations cf - , specialToks cf +cf2Bison :: RecordPositions -> ParserMode -> CF -> SymMap -> String +cf2Bison rp mode cf env = unlines + [ header mode cf + , render $ union mode $ posCats ++ allParserCatsNorm cf + , "" + , unionDependentCode mode + , unlines $ table " " $ concat + [ [ ["%token", "_ERROR_" ] ] + , tokens (map fst $ tokenPragmas cf) env + , specialToks cf + ] + , declarations mode cf , startSymbol cf , "" , "%%" , "" - , prRules (rulesForBison rp cf env) + , prRules $ rulesForBison rp mode cf env , "%%" , "" - , errorHandler name + , nsStart inPackage + , entryCode mode cf + , nsEnd inPackage ] + where + name = parserName mode + inPackage = parserPackage mode + posCats + | stlParser mode = map TokenCat $ positionCats cf + | otherwise = [] -header :: String -> CF -> String -header name cf = unlines - [ "/* This Bison file was machine-generated by BNFC */" +positionCats :: CF -> [String] +positionCats cf = [ wpThing name | TokenReg name True _ <- cfgPragmas cf ] + +header :: ParserMode -> CF -> String +header mode cf = unlines $ concat + [ [ "/* -*- c -*- This Bison file was machine-generated by BNFC */" , "" + , "/* Generate header file for lexer. */" + , "%defines \"" ++ ("Bison" <.> h) ++ "\"" + ] + , whenJust (parserPackage mode) $ \ ns -> + [ "%name-prefix = \"" ++ ns ++ "\"" + , " /* From Bison 2.6: %define api.prefix {" ++ ns ++ "} */" + ] + , [ "" + , "/* Reentrant parser */" + , "%pure_parser" + , " /* From Bison 2.3b (2008): %define api.pure full */" + -- The flag %pure_parser is deprecated with a warning since Bison 3.4, + -- but older Bisons like 2.3 (2006, shipped with macOS) don't recognize + -- %define api.pure full + , "%lex-param { yyscan_t scanner }" + , "%parse-param { yyscan_t scanner }" + , "" , concat [ "/* Turn on line/column tracking in the ", name, "lloc structure: */" ] , "%locations" , "" + , "/* Argument to the parser to be filled with the parsed tree. */" + , "%parse-param { YYSTYPE *result }" + , "" , "%{" , "/* Begin C preamble code */" , "" , "#include " , "#include " , "#include " - , "#include \"Absyn.h\"" + , "#include \"" ++ ("Absyn" <.> h) ++ "\"" , "" , "#define YYMAXDEPTH 10000000" -- default maximum stack size is 10000, but right-recursion needs O(n) stack , "" - , "typedef struct " ++ name ++ "_buffer_state *YY_BUFFER_STATE;" - , "YY_BUFFER_STATE " ++ name ++ "_scan_string(const char *str);" - , "void " ++ name ++ "_delete_buffer(YY_BUFFER_STATE buf);" - , "extern int yyparse(void);" - , "extern int yylex(void);" - , "extern int " ++ name ++ "_init_lexer(FILE * inp);" - -- this must be deferred until yylloc is defined - , "extern void yyerror(const char *str);" + , "/* The type yyscan_t is defined by flex, but we need it in the parser already. */" + , "#ifndef YY_TYPEDEF_YY_SCANNER_T" + , "#define YY_TYPEDEF_YY_SCANNER_T" + , "typedef void* yyscan_t;" + , "#endif" , "" - , concatMap reverseList $ filter isList $ allParserCatsNorm cf - , "/* Global variables holding parse results for entrypoints. */" - , unlines $ map parseResult $ nub $ map normCat eps - , unlines $ map (parseMethod cf name) eps - , "/* End C preamble code */" + -- , "typedef struct " ++ name ++ "_buffer_state *YY_BUFFER_STATE;" + , "typedef struct yy_buffer_state *YY_BUFFER_STATE;" + , "extern YY_BUFFER_STATE " ++ name ++ "_scan_string(const char *str, yyscan_t scanner);" + , "extern void " ++ name ++ "_delete_buffer(YY_BUFFER_STATE buf, yyscan_t scanner);" + , "" + , "extern void " ++ name ++ "lex_destroy(yyscan_t scanner);" + , "extern char* " ++ name ++ "get_text(yyscan_t scanner);" + , "" + , "extern yyscan_t " ++ name ++ "_initialize_lexer(FILE * inp);" + , "" + ] + , unless (stlParser mode) + [ "/* List reversal functions. */" + , concatMap (reverseList mode) $ filter isList $ allParserCatsNorm cf + ] + , [ "/* End C preamble code */" , "%}" ] + ] where eps = toList (allEntryPoints cf) -- Andreas, 2019-04-29, #210: Generate also parsers for CoercCat. -- WAS: (allCatsNorm cf) -- Found old comment: -- -- M.F. 2004-09-17 changed allEntryPoints to allCatsIdNorm. Seems to fix the [Ty2] bug. + h = parserHExt mode + name = parserName mode --- | Generates declaration and initialization of the @YY_RESULT@ for a parser. --- --- Different parsers (for different precedences of the same category) --- share such a declaration. +-- | Code that needs the @YYSTYPE@ defined by the @%union@ pragma. -- --- Expects a normalized category. -parseResult :: Cat -> String -parseResult cat = - dat +++ resultName dat +++ "= 0;" +unionDependentCode :: ParserMode -> String +unionDependentCode mode = unlines + [ "%{" + , errorHandler name + , "int yyparse(yyscan_t scanner, YYSTYPE *result);" + , "" + , "extern int yylex(YYSTYPE *lvalp, YYLTYPE *llocp, yyscan_t scanner);" + , "%}" + ] where - dat = identCat cat + name = parserName mode errorHandler :: String -> String errorHandler name = unlines - [ "void yyerror(const char *str)" + [ "void yyerror(YYLTYPE *loc, yyscan_t scanner, YYSTYPE *result, const char *msg)" , "{" - , " extern char *" ++ name ++ "text;" - , " fprintf(stderr,\"error: %d,%d: %s at %s\\n\"," - , " " ++ name ++ "lloc.first_line, " ++ name ++ "lloc.first_column, str, " ++ name ++ "text);" + , " fprintf(stderr, \"error: %d,%d: %s at %s\\n\"," + , " loc->first_line, loc->first_column, msg, " ++ name ++ "get_text(scanner));" , "}" ] +-- | Parser entry point code. +-- +entryCode :: ParserMode -> CF -> String +entryCode mode cf = unlines $ map (parseMethod mode cf) eps + where + eps = toList (allEntryPoints cf) + --This generates a parser method for each entry point. -parseMethod :: CF -> String -> Cat -> String -parseMethod cf name cat = unlines $ - [ unwords [ "/* Entrypoint: parse", dat, "from file. */" ] - , dat ++ " p" ++ parser ++ "(FILE *inp)" - , "{" - , " " ++ name ++ "_init_lexer(inp);" - , " int result = yyparse();" - , " if (result)" - , " { /* Failure */" - , " return 0;" - , " }" - , " else" - , " { /* Success */" - , " return" +++ res ++ ";" - , " }" - , "}" - , "" - , unwords [ "/* Entrypoint: parse", dat, "from string. */" ] - , dat ++ " ps" ++ parser ++ "(const char *str)" - , "{" - , " YY_BUFFER_STATE buf;" - , " " ++ name ++ "_init_lexer(0);" - , " buf = " ++ name ++ "_scan_string(str);" - , " int result = yyparse();" - , " " ++ name ++ "_delete_buffer(buf);" - , " if (result)" - , " { /* Failure */" - , " return 0;" - , " }" - , " else" - , " { /* Success */" - , " return" +++ res ++ ";" - , " }" - , "}" +parseMethod :: ParserMode -> CF -> Cat -> String +parseMethod mode cf cat = unlines $ concat + [ [ unwords [ "/* Entrypoint: parse", dat, "from file. */" ] + , dat ++ " p" ++ parser ++ "(FILE *inp)" + ] + , body False + , [ "" + , unwords [ "/* Entrypoint: parse", dat, "from string. */" ] + , dat ++ " ps" ++ parser ++ "(const char *str)" + ] + , body True ] where - dat = identCat (normCat cat) + name = parserName mode + body stringParser = concat + [ [ "{" + , " YYSTYPE result;" + , " yyscan_t scanner = " ++ name ++ "_initialize_lexer(" ++ file ++ ");" + , " if (!scanner) {" + , " fprintf(stderr, \"Failed to initialize lexer.\\n\");" + , " return 0;" + , " }" + ] + , [ " YY_BUFFER_STATE buf = " ++ name ++ "_scan_string(str, scanner);" | stringParser ] + , [ " int error = yyparse(scanner, &result);" ] + , [ " " ++ name ++ "_delete_buffer(buf, scanner);" | stringParser ] + , [ " " ++ name ++ "lex_destroy(scanner);" + , " if (error)" + , " { /* Failure */" + , " return 0;" + , " }" + , " else" + , " { /* Success */" + ] + , revOpt + , [ " return" +++ res ++ ";" + , " }" + , "}" + ] + ] + where + file | stringParser = "0" + | otherwise = "inp" + stl = stlParser mode + ncat = normCat cat + dat0 = identCat ncat + dat = if cParser mode then dat0 else dat0 ++ "*" parser = identCat cat - res0 = resultName dat - revRes = "reverse" ++ dat ++ "(" ++ res0 ++ ")" - res = if cat `elem` cfgReversibleCats cf then revRes else res0 + res0 = concat [ "result.", varName ncat ] + -- Reversing the result + isReversible = cat `elem` cfgReversibleCats cf + -- C and NoSTL + res + | not stl, isReversible + = "reverse" ++ dat0 ++ "(" ++ res0 ++ ")" + | otherwise = res0 + -- STL: Vectors are snoc lists + revOpt = when (stl && isList cat && not isReversible) + [ "std::reverse(" ++ res ++ "->begin(), " ++ res ++"->end());" ] --This method generates list reversal functions for each list type. -reverseList :: Cat -> String -reverseList c = unlines - [ - c' ++ " reverse" ++ c' ++ "(" ++ c' +++ "l)", - "{", - " " ++ c' +++"prev = 0;", - " " ++ c' +++"tmp = 0;", - " while (l)", - " {", - " tmp = l->" ++ v ++ ";", - " l->" ++ v +++ "= prev;", - " prev = l;", - " l = tmp;", - " }", - " return prev;", - "}" - ] - where - c' = identCat (normCat c) - v = map toLower c' ++ "_" - ---The union declaration is special to Bison/Yacc and gives the type of yylval. ---For efficiency, we may want to only include used categories here. -union :: [Cat] -> String -union cats = unlines $ concat - [ [ "/* The type of a parse result (yylval). */" ] - , [ "%union" +reverseList :: ParserMode -> Cat -> String +reverseList mode c0 = unlines + [ c' ++ " reverse" ++ c ++ "(" ++ c' +++ "l)" , "{" + , " " ++ c' +++"prev = 0;" + , " " ++ c' +++"tmp = 0;" + , " while (l)" + , " {" + , " tmp = l->" ++ v ++ ";" + , " l->" ++ v +++ "= prev;" + , " prev = l;" + , " l = tmp;" + , " }" + , " return prev;" + , "}" ] - , map (" " ++) unionBuiltinTokens - , concatMap mkPointer cats - , [ "}" + where + c = identCat (normCat c0) + c' = c ++ star + v = map toLower c ++ "_" + star = if cParser mode then "" else "*" + +-- | The union declaration is special to Bison/Yacc and gives the type of +-- yylval. For efficiency, we may want to only include used categories here. +-- +-- >>> let foo = Cat "Foo" +-- >>> union (CParser True "") [foo, ListCat foo] +-- %union +-- { +-- int _int; +-- char _char; +-- double _double; +-- char* _string; +-- Foo* foo_; +-- ListFoo* listfoo_; +-- } +-- +-- If the given list of categories is contains coerced categories, those should +-- be normalized and duplicate removed +-- E.g. if there is both [Foo] and [Foo2] we should only print one pointer: +-- ListFoo* listfoo_; +-- +-- >>> let foo2 = CoercCat "Foo" 2 +-- >>> union (CppParser Nothing "") [foo, ListCat foo, foo2, ListCat foo2] +-- %union +-- { +-- int _int; +-- char _char; +-- double _double; +-- char* _string; +-- Foo* foo_; +-- ListFoo* listfoo_; +-- } +union :: ParserMode -> [Cat] -> Doc +union mode cats = vcat + [ "%union" + , codeblock 2 $ map text unionBuiltinTokens ++ map mkPointer normCats ] - ] ---This is a little weird because people can make [Exp2] etc. -mkPointer :: Cat -> [String] -mkPointer c - | identCat c /= show c --list. add it even if it refers to a coercion. - || normCat c == c --normal cat - = [ " " ++ identCat (normCat c) +++ varName (normCat c) ++ ";" ] - | otherwise = [] + where + normCats = nub (map normCat cats) + mkPointer s = scope <> text (identCat s) <> star <+> text (varName s) <> ";" + scope = text $ nsScope $ parserPackage mode + star = if cParser mode then empty else text "*" unionBuiltinTokens :: [String] unionBuiltinTokens = @@ -218,23 +320,27 @@ , "char* _string;" ] ---declares non-terminal types. -declarations :: CF -> String -declarations cf = concatMap (typeNT cf) (allParserCats cf) - where --don't define internal rules - typeNT cf nt | rulesForCat cf nt /= [] = "%type <" ++ varName (normCat nt) ++ "> " ++ identCat nt ++ "\n" - typeNT _ _ = "" +-- | @%type@ declarations for non-terminal types. +declarations :: ParserMode -> CF -> String +declarations mode cf = unlines $ map typeNT $ + posCats ++ + filter (not . null . rulesForCat cf) (allParserCats cf) -- don't define internal rules + where + typeNT nt = "%type <" ++ varName nt ++ "> " ++ identCat nt + posCats + | stlParser mode = map TokenCat $ positionCats cf + | otherwise = [] --declares terminal types. -- token name "literal" -- "Syntax error messages passed to yyerror from the parser will reference the literal string instead of the token name." -- https://www.gnu.org/software/bison/manual/html_node/Token-Decl.html -tokens :: [UserDef] -> SymMap -> String -tokens user env = unlines $ map declTok $ Map.toList env - where +tokens :: [UserDef] -> SymMap -> [[String]] +tokens user env = map declTok $ Map.toList env + where declTok (Keyword s, r) = tok "" s r declTok (Tokentype s, r) = tok (if s `elem` user then "<_string>" else "") s r - tok t s r = "%token" ++ t ++ " " ++ r ++ " /* " ++ cStringEscape s ++ " */" + tok t s r = [ "%token" ++ t, r, " /* " ++ cStringEscape s ++ " */" ] -- | Escape characters inside a C string. cStringEscape :: String -> String @@ -244,13 +350,14 @@ | c `elem` ("\"\\" :: String) = '\\':[c] | otherwise = [c] -specialToks :: CF -> String -specialToks cf = unlines $ concat - [ ifC catString "%token<_string> _STRING_" - , ifC catChar "%token<_char> _CHAR_" - , ifC catInteger "%token<_int> _INTEGER_" - , ifC catDouble "%token<_double> _DOUBLE_" - , ifC catIdent "%token<_string> _IDENT_" +-- | Produces a table with the built-in token types. +specialToks :: CF -> [[String]] +specialToks cf = concat + [ ifC catString [ "%token<_string>", "_STRING_" ] + , ifC catChar [ "%token<_char> ", "_CHAR_" ] + , ifC catInteger [ "%token<_int> ", "_INTEGER_" ] + , ifC catDouble [ "%token<_double>", "_DOUBLE_" ] + , ifC catIdent [ "%token<_string>", "_IDENT_" ] ] where ifC cat s = if isUsedCat cf (TokenCat cat) then [s] else [] @@ -261,74 +368,136 @@ --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs -rulesForBison :: RecordPositions -> CF -> SymMap -> Rules -rulesForBison rp cf env = map mkOne $ ruleGroups cf where - mkOne (cat,rules) = constructRule rp cf env rules cat +rulesForBison :: RecordPositions -> ParserMode -> CF -> SymMap -> Rules +rulesForBison rp mode cf env = map mkOne (ruleGroups cf) ++ posRules + where + mkOne (cat,rules) = constructRule rp mode cf env rules cat + posRules :: Rules + posRules + | CppParser inPackage _ <- mode = for (positionCats cf) $ \ n -> (TokenCat n, + [( Map.findWithDefault n (Tokentype n) env + , addResult cf (TokenCat n) $ concat + [ "$$ = new ", nsScope inPackage, n, "($1, @$.first_line);" ] + )]) + | otherwise = [] -- For every non-terminal, we construct a set of rules. constructRule - :: RecordPositions -> CF -> SymMap + :: RecordPositions -> ParserMode -> CF -> SymMap -> [Rule] -- ^ List of alternatives for parsing ... -> NonTerminal -- ^ ... this non-terminal. -> (NonTerminal,[(Pattern,Action)]) -constructRule rp cf env rules nt = (nt,) $ - [ (p,) $ addResult $ generateAction rp (identCat (normCat nt)) (funRule r) b m +constructRule rp mode cf env rules nt = (nt,) $ + [ (p,) $ addResult cf nt $ generateAction rp mode (identCat (normCat nt)) (funRule r) b m | r0 <- rules , let (b,r) = if isConsFun (funRule r0) && valCat r0 `elem` cfgReversibleCats cf then (True, revSepListRule r0) else (False, r0) - , let (p,m) = generatePatterns cf env r + , let (p,m) = generatePatterns mode cf env r ] - where - -- Add action if we parse an entrypoint non-terminal: - -- Set field in result record to current parse. - addResult a = - if nt `elem` toList (allEntryPoints cf) - -- Note: Bison has only a single entrypoint, - -- but BNFC works around this by adding dedicated parse methods for all entrypoints. - then a +++ resultName (identCat (normCat nt)) ++ "= $$;" - else a +-- | Add action if we parse an entrypoint non-terminal: +-- Set field in result record to current parse. +addResult :: CF -> NonTerminal -> Action -> Action +addResult cf nt a = + if nt `elem` toList (allEntryPoints cf) + -- Note: Bison has only a single entrypoint, + -- but BNFC works around this by adding dedicated parse methods for all entrypoints. + -- Andreas, 2021-03-24: But see #350: bison still uses only the @%start@ non-terminal. + then concat [ a, " result->", varName (normCat nt), " = $$;" ] + else a + +-- | Switch between STL or not. +generateAction :: IsFun a + => RecordPositions -- ^ Remember position information? + -> ParserMode -- ^ For C or C++? + -> String -- ^ List type. + -> a -- ^ Rule name. + -> Bool -- ^ Reverse list? + -> [(MetaVar, Bool)] -- ^ Meta-vars; should the list referenced by the var be reversed? + -> Action +generateAction rp = \case + CppParser ns _ -> generateActionSTL rp ns + CParser b _ -> \ nt f r -> generateActionC rp (not b) nt f r . map fst + -- | Generates a string containing the semantic action. --- >>> generateAction NoRecordPositions "Foo" "Bar" False ["$1"] --- "make_Bar($1);" --- >>> generateAction NoRecordPositions "Foo" "_" False ["$1"] --- "$1;" --- >>> generateAction NoRecordPositions "ListFoo" "[]" False [] --- "0;" --- >>> generateAction NoRecordPositions "ListFoo" "(:[])" False ["$1"] --- "make_ListFoo($1, 0);" --- >>> generateAction NoRecordPositions "ListFoo" "(:)" False ["$1","$2"] --- "make_ListFoo($1, $2);" --- >>> generateAction NoRecordPositions "ListFoo" "(:)" True ["$1","$2"] --- "make_ListFoo($2, $1);" -generateAction :: IsFun a => RecordPositions -> String -> a -> Bool -> [MetaVar] -> Action -generateAction rp nt f b ms - | isCoercion f = unwords ms ++ ";" ++ loc - | isNilFun f = "0;" - | isOneFun f = concat ["make_", nt, "(", intercalate ", " ms', ", 0);"] - | isConsFun f = concat ["make_", nt, "(", intercalate ", " ms', ");"] - | otherwise = concat ["make_", funName f, "(", intercalate ", " ms', ");", loc] +-- >>> generateActionC NoRecordPositions False "Foo" "Bar" False ["$1"] +-- "$$ = new Bar($1);" +-- >>> generateActionC NoRecordPositions True "Foo" "Bar" False ["$1"] +-- "$$ = make_Bar($1);" +-- >>> generateActionC NoRecordPositions True "Foo" "_" False ["$1"] +-- "$$ = $1;" +-- >>> generateActionC NoRecordPositions True "ListFoo" "[]" False [] +-- "$$ = 0;" +-- >>> generateActionC NoRecordPositions True "ListFoo" "(:[])" False ["$1"] +-- "$$ = make_ListFoo($1, 0);" +-- >>> generateActionC NoRecordPositions True "ListFoo" "(:)" False ["$1","$2"] +-- "$$ = make_ListFoo($1, $2);" +-- >>> generateActionC NoRecordPositions True "ListFoo" "(:)" True ["$1","$2"] +-- "$$ = make_ListFoo($2, $1);" +generateActionC :: IsFun a => RecordPositions -> Bool -> String -> a -> Bool -> [MetaVar] -> Action +generateActionC rp cParser nt f b ms + | isCoercion f = "$$ = " ++ unwords ms ++ ";" ++ loc + | isNilFun f = "$$ = 0;" + | isOneFun f = concat ["$$ = ", new nt, "(", intercalate ", " ms', ", 0);"] + | isConsFun f = concat ["$$ = ", new nt, "(", intercalate ", " ms', ");"] + | otherwise = concat ["$$ = ", new (funName f), "(", intercalate ", " ms', ");", loc] where ms' = if b then reverse ms else ms - loc = if rp == RecordPositions then " $$->line_number = @$.first_line; $$->char_number = @$.first_column;" else "" + loc | RecordPositions <- rp + = " $$->line_number = @$.first_line; $$->char_number = @$.first_column;" + | otherwise + = "" + new :: String -> String + new | cParser = ("make_" ++) + | otherwise = \ s -> if isUpper (head s) then "new " ++ s else sanitizeCpp s +generateActionSTL :: IsFun a => RecordPositions -> InPackage -> String -> a -> Bool -> [(MetaVar,Bool)] -> Action +generateActionSTL rp inPackage nt f b mbs = reverses ++ + if | isCoercion f -> concat ["$$ = ", unwords ms, ";", loc] + | isNilFun f -> concat ["$$ = ", "new ", scope, nt, "();"] + | isOneFun f -> concat ["$$ = ", "new ", scope, nt, "(); $$->push_back(", head ms, ");"] + | isConsFun f -> concat [lst, "->push_back(", el, "); $$ = ", lst, ";"] + | isDefinedRule f -> concat ["$$ = ", scope, sanitizeCpp (funName f), "(", intercalate ", " ms, ");" ] + | otherwise -> concat ["$$ = ", "new ", scope, funName f, "(", intercalate ", " ms, ");", loc] + where + ms = map fst mbs + -- The following match only happens in the cons case: + [el, lst] = applyWhen b reverse ms -- b: left-recursion transformed? + + loc | RecordPositions <- rp + = " $$->line_number = @$.first_line; $$->char_number = @$.first_column;" + | otherwise + = "" + reverses = unwords ["std::reverse(" ++ m ++"->begin(),"++m++"->end()) ;" | (m, True) <- mbs] + scope = nsScope inPackage + -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal -generatePatterns :: CF -> SymMap -> Rule -> (Pattern,[MetaVar]) -generatePatterns cf env r = case rhsRule r of +generatePatterns :: ParserMode -> CF -> SymMap -> Rule -> (Pattern,[(MetaVar,Bool)]) +generatePatterns mode cf env r = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where - mkIt i = case i of - Left (TokenCat s) -> fromMaybe (typeName s) $ Map.lookup (Tokentype s) env + stl = stlParser mode + mkIt = \case + Left (TokenCat s) + | stl && isPositionCat cf s + -> typeName s + | otherwise -> Map.findWithDefault (typeName s) (Tokentype s) env Left c -> identCat c - Right s -> fromMaybe s $ Map.lookup (Keyword s) env - metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 :: Int ..] its] - revIf c m = if not (isConsFun (funRule r)) && elem c revs + Right s -> Map.findWithDefault s (Keyword s) env + metas its = [(revIf c ('$': show i), revert c) | (i, Left c) <- zip [1 :: Int ..] its] + -- C and C++/NoSTL: call reverse function + revIf c m = if not stl && isntCons && elem c revs then "reverse" ++ identCat (normCat c) ++ "(" ++ m ++ ")" else m -- no reversal in the left-recursive Cons rule itself - revs = cfgReversibleCats cf + -- C++/STL: flag if reversal is necessary + -- notice: reversibility with push_back vectors is the opposite + -- of right-recursive lists! + revert c = isntCons && isList c && notElem c revs + revs = cfgReversibleCats cf + isntCons = not $ isConsFun $ funRule r -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. @@ -337,11 +506,11 @@ prRules [] = [] prRules ((_, []):rs) = prRules rs --internal rule prRules ((nt, (p,a) : ls):rs) = - unwords [nt', ":" , p, "{ $$ =", a, "}", '\n' : pr ls] ++ ";\n" ++ prRules rs + unwords [nt', ":" , p, "{", a, "}", '\n' : pr ls] ++ ";\n" ++ prRules rs where nt' = identCat nt pr [] = [] - pr ((p,a):ls) = unlines [unwords [" |", p, "{ $$ =", a , "}"]] ++ pr ls + pr ((p,a):ls) = unlines [unwords [" |", p, "{", a , "}"]] ++ pr ls --Some helper functions. resultName :: String -> String diff --git a/src/BNFC/Backend/C/CFtoCAbs.hs b/src/BNFC/Backend/C/CFtoCAbs.hs --- a/src/BNFC/Backend/C/CFtoCAbs.hs +++ b/src/BNFC/Backend/C/CFtoCAbs.hs @@ -18,15 +18,24 @@ module BNFC.Backend.C.CFtoCAbs (cf2CAbs) where import Prelude hiding ((<>)) -import Data.Char (toLower) -import Data.Function (on) -import Data.List (groupBy, intercalate, nub, sort) +import Control.Monad.State (State, gets, modify, evalState) + +import Data.Char ( toLower ) +import Data.Either ( lefts ) +import Data.Function ( on ) +import Data.List ( groupBy, intercalate, intersperse, nub, sort ) +import Data.Maybe ( mapMaybe ) +import Data.Set ( Set ) + +import qualified Data.Set as Set + import BNFC.CF import BNFC.PrettyPrint -import BNFC.Options (RecordPositions(..)) -import BNFC.Utils ((+++), uncurry3, unless) +import BNFC.Options ( RecordPositions(..) ) +import BNFC.Utils ( (+++), uncurry3, unless ) import BNFC.Backend.Common.NamedVariables +import BNFC.Backend.C.Common ( posixC ) -- | The result is two files (.H file, .C file) @@ -35,32 +44,60 @@ -> String -- ^ Ignored. -> CF -- ^ Grammar. -> (String, String) -- ^ @.H@ file, @.C@ file. -cf2CAbs rp _ cf = (mkHFile rp cf, mkCFile cf) +cf2CAbs rp _ cf = (mkHFile rp classes datas cf, mkCFile datas cf) + where + datas :: [Data] + datas = getAbstractSyntax cf + classes :: [String] + classes = nub $ map (identCat . fst) datas {- **** Header (.H) File Functions **** -} -- | Makes the Header file. -mkHFile :: RecordPositions -> CF -> String -mkHFile rp cf = unlines $ concat +mkHFile :: RecordPositions -> [String] -> [Data] -> CF -> String +mkHFile rp classes datas cf = unlines $ concat [ [ "#ifndef ABSYN_HEADER" , "#define ABSYN_HEADER" , "" + ] + , posixC + , [ "" + , "#include /* NULL */" + , "#include /* strdup */" + , "" , "/* C++ Abstract Syntax Interface generated by the BNF Converter.*/" , "" , prTypeDefs user , "/******************** Forward Declarations ***********************/" ] , map prForward classes + , [ "/******************** Abstract Syntax Classes ********************/" , "" ] - , map (prDataH rp) $ getAbstractSyntax cf + , map (prDataH rp) datas + + -- Cloning + , unless (null classes) $ concat + [ cloneComment + , map prCloneH classes + , [ "" ] + ] + + -- Freeing + , unless (null classes) $ concat + [ destructorComment + , map prFreeH classes + , [ "" ] + ] + , unless (null definedConstructors) [ "/******************** Defined Constructors ***********************/" , "" ] - , map (uncurry3 (prDefH user)) definedConstructors + , intersperse "" $ map (prDefH user) definedConstructors + , [ "" , "#endif" ] @@ -68,49 +105,95 @@ where user :: [TokenCat] user = tokenNames cf - rules :: [String] - rules = getRules cf - classes = nub (rules ++ getClasses (allCatsNorm cf)) - prForward s | not (isCoercion s) = unlines + prForward :: String -> String + prForward s = unlines [ "struct " ++ s ++ "_;" , "typedef struct " ++ s ++ "_ *" ++ s ++ ";" ] - prForward _ = "" - getRules cf = map testRule (cfgRules cf) - getClasses = map show . filter isDataCat - testRule (Rule f (WithPosition _ c) _ _) - | isList c && isConsFun f = identCat (normCat c) - | otherwise = "_" - definedConstructors = [ (funName f, xs, e) | FunDef f xs e <- cfgPragmas cf ] + prCloneH :: String -> String + prCloneH s = s ++ " clone_" ++ s ++ "(" ++ s ++ " p);" + prFreeH :: String -> String + prFreeH s = "void free_" ++ s ++ "(" ++ s ++ " p);" + definedConstructors = definitions cf +cloneComment :: [String] +cloneComment = + [ "/*************************** Cloning ******************************/" + , "" + ] + +destructorComment :: [String] +destructorComment = + [ "/******************** Recursive Destructors **********************/" + , "" + , "/* These free an entire abstract syntax tree" + , " * including all subtrees and strings." + , " *" + , " * Will not work properly if there is sharing in the tree," + , " * i.e., when some pointers are aliased. In this case" + , " * it will attempt to free the same memory twice." + , " */" + , "" + ] + -- | For @define@d constructors, make a CPP definition. -- --- >>> prDefH [] "iSg" ["i"] (App "ICons" [Var "i", App "INil" []]) --- "#define make_iSg(i) make_ICons(i,make_INil())" +-- >>> prDefH [] (Define "iSg" [("i",undefined)] (App "ICons" undefined [Var "i", App "INil" undefined []]) undefined) +-- "#define make_iSg(i) \\\n make_ICons (i, make_INil())" -- --- >>> prDefH [] "snoc" ["xs","x"] (App "Cons" [Var "x", Var "xs"]) --- "#define make_snoc(xs,x) make_Cons(x,xs)" +-- >>> prDefH [] (Define "snoc" (map (,undefined) ["xs","x"]) (App "Cons" undefined [Var "x", Var "xs"]) undefined) +-- "#define make_snoc(xs,x) \\\n make_Cons (x, xs)" -- prDefH :: [TokenCat] -- ^ Names of the token constructors (silent in C backend). - -> String -- ^ Name of the defined constructor. - -> [String] -- ^ Names of the arguments. - -> Exp -- ^ Definition (referring to arguments and rule labels). + -> Define -> String -prDefH tokenCats f xs e = concat [ "#define make_", f, "(", intercalate "," xs, ") ", prExp e ] +prDefH tokenCats (Define fun args e _t) = + concat [ "#define make_", f, "(", intercalate "," xs, ") \\\n ", prExp e `evalState` mempty ] where - prExp :: Exp -> String + f = funName fun + xs = map fst args + + toCat :: Base -> Cat + toCat = catOfType $ specialCatsP ++ tokenCats + + -- Issue #363, #348. + -- Duplicate occurrences of variables in expression need to be cloned, + -- because deallocation assumes that the AST is in fact a tree. + -- Duplicate occurrences introduce sharing and thus turn it into a DAG + -- (directed acyclic graph). + -- We maintain a set of variables we have already encountered. + prExp :: Exp -> State (Set String) String prExp = \case - Var x -> x + + Var x -> gets (Set.member x) >>= \case + -- The first use is not cloned. + False -> x <$ modify (Set.insert x) + -- Subsequent uses are cloned. + True -> case lookup x args of + Just t -> return $ cloner (toCat t) x + -- pattern match left incomplete on purpose + -- Andreas, 2021-02-13, issue #338 -- Token categories are just @typedef@s in C, so no constructor needed. - App g [e] | g `elem` tokenCats + App g _ [e] | g `elem` tokenCats -> prExp e - App g es -> concat [ "make_", g, "(", intercalate "," (map prExp es), ")" ] - LitInt i -> show i - LitDouble d -> show d - LitChar c -> show c - LitString s -> show s + App "[]" _ [] -> return "NULL" + App g t es -> do + es' <- mapM prExp es + return $ concat [ "make_", con g t, lparen es, intercalate ", " es', ")" ] + LitInt i -> return $ show i + LitDouble d -> return $ show d + LitChar c -> return $ show c + LitString s -> return $ concat [ "strdup(", show s, ")" ] -- so that free() does not crash! + con g ~(FunT ts t) + | isConsFun g = identType t + | otherwise = g + -- If more than one argument, or complex argument, put space before opening parenthesis. + lparen = \case + _:_:_ -> " (" + [App _ _ (_:_)] -> " (" + _ -> "(" -- | Prints struct definitions for all categories. prDataH :: RecordPositions -> Data -> String @@ -125,7 +208,7 @@ , c' ++ " make_" ++ c' ++ "(" ++ mem ++ " p1, " ++ c' ++ " p2);" ] | otherwise = unlines $ concat - [ [ "struct " ++ show cat ++ "_" + [ [ "struct " ++ identCat cat ++ "_" , "{" ] , [ " int line_number, char_number;" | rp == RecordPositions ] @@ -191,10 +274,17 @@ {- **** Implementation (.C) File Functions **** -} -- | Makes the .C file -mkCFile :: CF -> String -mkCFile cf = concat +mkCFile :: [Data] -> CF -> String +mkCFile datas cf = concat [ header - , render $ vsep $ concatMap prDataC $ getAbstractSyntax cf + , render $ vsep $ concatMap prDataC datas + , unlines [ "", "" ] + -- Cloning + , unlines cloneComment + , unlines $ concatMap prCloneC datas + -- Freeing + , unlines destructorComment + , unlines $ concatMap prDestructorC datas ] where header = unlines @@ -205,6 +295,197 @@ , "#include \"Absyn.h\"" , "" ] + +-- | +-- >>> text $ unlines $ prCloneC (Cat "Exp", [("EInt", [TokenCat "Integer"]), ("EAdd", [Cat "Exp", Cat "Exp"])]) +-- Exp clone_Exp(Exp p) +-- { +-- switch(p->kind) +-- { +-- case is_EInt: +-- return make_EInt (p->u.eint_.integer_); +-- +-- case is_EAdd: +-- return make_EAdd +-- ( clone_Exp(p->u.eadd_.exp_1) +-- , clone_Exp(p->u.eadd_.exp_2) +-- ); +-- +-- default: +-- fprintf(stderr, "Error: bad kind field when cloning Exp!\n"); +-- exit(1); +-- } +-- } +-- +-- +prCloneC :: Data -> [String] +prCloneC (cat, rules) + | isList cat = + [ cl ++ " clone_" ++ cl ++ "("++ cl +++ vname ++ ")" + , "{" + , " if (" ++ vname ++ ")" + , " {" + , " /* clone of non-empty list */" + , render $ prettyList 6 (text $ " return make_" ++ cl) "(" ");" "," + [ text $ visitMember + , text $ "clone_" ++ cl ++ "(" ++ vname ++ "->" ++ vname ++ "_)" + ] + , " }" + , " else return NULL; /* clone of empty list */" + , "}" + , "" + ] + | otherwise = concat + [ [ cl ++ " clone_" ++ cl ++ "(" ++ cl ++ " p)" + , "{" + , " switch(p->kind)" + , " {" + ] + , concatMap prCloneRule rules + , [ " default:" + , " fprintf(stderr, \"Error: bad kind field when cloning " ++ cl ++ "!\\n\");" + , " exit(1);" + , " }" + , "}" + , "" + ] + ] + where + cl = identCat cat + vname = map toLower cl + visitMember :: String + visitMember = cloner el $ vname ++ "->" ++ member ++ "_" + where + el = normCatOfList cat + member = map toLower $ identCat el + + prCloneRule :: (String, [Cat]) -> [String] + prCloneRule (fun, cats) | not (isCoercion fun) = + [ " case is_" ++ fnm ++ ":" + , render $ prettyList 6 (text $ " return make_" ++ fnm) "(" ");\n" "," $ + map (text . prCloneCat fnm) $ lefts $ numVars $ map Left cats + ] + where + fnm = funName fun + prCloneRule _ = [] + + -- | This goes on to recurse to the instance variables. + + prCloneCat :: String -> (Cat, Doc) -> String + prCloneCat fnm (cat, nt) = cloner cat member + where + member = concat [ "p->u.", map toLower fnm, "_.", render nt ] + +-- | Clone or not depending on the category. +-- Only pointers need to be cloned. +-- +cloner :: Cat -> String -> String +cloner cat x = + case cat of + TokenCat c + | c `elem` ["Char", "Double", "Integer"] + -> x + | otherwise -> "strdup" ++ parens x + _ -> "clone_" ++ identCat (normCat cat) ++ parens x + where parens = ("(" ++) . (++ ")") + + +-- | +-- >>> text $ unlines $ prDestructorC (Cat "Exp", [("EInt", [TokenCat "Integer"]), ("EAdd", [Cat "Exp", Cat "Exp"])]) +-- void free_Exp(Exp p) +-- { +-- switch(p->kind) +-- { +-- case is_EInt: +-- break; +-- +-- case is_EAdd: +-- free_Exp(p->u.eadd_.exp_1); +-- free_Exp(p->u.eadd_.exp_2); +-- break; +-- +-- default: +-- fprintf(stderr, "Error: bad kind field when freeing Exp!\n"); +-- exit(1); +-- } +-- free(p); +-- } +-- +-- +prDestructorC :: Data -> [String] +prDestructorC (cat, rules) + | isList cat = concat + [ [ "void free_" ++ cl ++ "("++ cl +++ vname ++ ")" + , "{" + , " if (" ++ vname ++ ")" + , " {" + ] + , map (" " ++) visitMember + , [ " free_" ++ cl ++ "(" ++ vname ++ "->" ++ vname ++ "_);" + , " free(" ++ vname ++ ");" + , " }" + , "}" + , "" + ] + ] + | otherwise = concat + [ [ "void free_" ++ cl ++ "(" ++ cl ++ " p)" + , "{" + , " switch(p->kind)" + , " {" + ] + , concatMap prFreeRule rules + , [ " default:" + , " fprintf(stderr, \"Error: bad kind field when freeing " ++ cl ++ "!\\n\");" + , " exit(1);" + , " }" + , " free(p);" + , "}" + , "" + ] + ] + where + cl = identCat cat + vname = map toLower cl + visitMember = + case ecat of + TokenCat c + | c `elem` ["Char", "Double", "Integer"] -> [] + | otherwise -> [ "free" ++ rest ] + _ -> [ "free_" ++ ecl ++ rest ] + where + rest = "(" ++ vname ++ "->" ++ member ++ "_);" + member = map toLower ecl + ecl = identCat ecat + ecat = normCatOfList cat + + prFreeRule :: (String, [Cat]) -> [String] + prFreeRule (fun, cats) | not (isCoercion fun) = concat + [ [ " case is_" ++ fnm ++ ":" + ] + , map (" " ++) $ mapMaybe (prFreeCat fnm) $ lefts $ numVars $ map Left cats + , [ " break;" + , "" + ] + ] + where + fnm = funName fun + prFreeRule _ = [] + + -- | This goes on to recurse to the instance variables. + + prFreeCat :: String -> (Cat, Doc) -> Maybe String + prFreeCat fnm (TokenCat c, nt) + | c `elem` ["Char", "Double", "Integer"] = Nothing + -- Only pointer need to be freed. + prFreeCat fnm (cat, nt) = Just $ concat + [ maybe ("free_" ++ identCat (normCat cat)) (const "free") $ maybeTokenCat cat + , "(p->u." + , map toLower fnm + , "_.", render nt, ");" + ] + + prDataC :: Data -> [Doc] prDataC (cat, rules) = map (prRuleC cat) rules diff --git a/src/BNFC/Backend/C/CFtoCPrinter.hs b/src/BNFC/Backend/C/CFtoCPrinter.hs --- a/src/BNFC/Backend/C/CFtoCPrinter.hs +++ b/src/BNFC/Backend/C/CFtoCPrinter.hs @@ -26,11 +26,13 @@ import Data.Either ( lefts ) import Data.Foldable ( toList ) import Data.List ( nub ) +import Data.Maybe ( isJust ) import BNFC.CF import BNFC.PrettyPrint -import BNFC.Utils ((+++), unless) -import BNFC.Backend.Common (renderListSepByPrecedence) +import BNFC.Utils ( (+++), uniqOn, whenJust, unless, unlessNull ) + +import BNFC.Backend.Common import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Common.StrUtils (renderCharOrString) @@ -85,6 +87,9 @@ "void renderCS(String s);", "void indent(void);", "void backup(void);", + "void onEmptyLine(void);", + "void removeTrailingSpaces(void);", + "void removeTrailingWhitespace(void);", "" ] footer = unlines $ @@ -341,25 +346,25 @@ | isList cat = unlines $ concat [ [ "void pp" ++ cl ++ "("++ cl +++ vname ++ ", int i)" , "{" - , " while(" ++ vname +++ "!= 0)" - , " {" - , " if (" ++ vname ++ "->" ++ vname ++ "_ == 0)" - , " {" - , visitMember + , " if (" ++ vname +++ "== 0)" + , " { /* nil */" ] - , unless (hasOneFunc rules) - [ " " ++ render (renderX $ getCons rules) ++ ";" ] - , [ " " ++ vname +++ "= 0;" - , " }" - , " else" - , " {" - , visitMember - , render (nest 6 (renderListSepByPrecedence "i" renderX - (getSeparatorByPrecedence rules))) - , " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;" - , " }" + , unlessNull (swRules isNilFun) $ \ docs -> + [ render $ nest 4 $ vcat docs ] + , [ " }" ] + , unlessNull (swRules isOneFun) $ \ docs -> + [ " else if (" ++ pre ++ vname ++ "_ == 0)" + , " { /* last */" + , render $ nest 4 $ vcat docs , " }" - , "}" + ] + , unlessNull (swRules isConsFun) $ \ docs -> + [ " else" + , " { /* cons */" + , render $ nest 4 $ vcat docs + , " }" + ] + , [ "}" , "" ] ] @@ -371,7 +376,7 @@ ] , concatMap prPrintRule rules , [ " default:" - , " fprintf(stderr, \"Error: bad kind field when printing " ++ show cat ++ "!\\n\");" + , " fprintf(stderr, \"Error: bad kind field when printing " ++ catToStr cat ++ "!\\n\");" , " exit(1);" , " }" , "}" @@ -380,10 +385,13 @@ ] where cl = identCat (normCat cat) - ecl = identCat (normCatOfList cat) vname = map toLower cl - member = map toLower ecl - visitMember = " pp" ++ ecl ++ "(" ++ vname ++ "->" ++ member ++ "_, i);" + pre = vname ++ "->" + prules = sortRulesByPrecedence rules + swRules f = switchByPrecedence "i" $ + map (second $ sep . map text . prPrintRule_ pre) $ + uniqOn fst $ filter f prules + -- Discard duplicates, can only handle one rule per precedence. -- | Helper function that call the right c function (renderC or renderS) to -- render a literal string. @@ -402,32 +410,35 @@ -- | Pretty Printer methods for a rule. prPrintRule :: Rule -> [String] -prPrintRule r@(Rule fun _ cats _) | not (isCoercion fun) = concat - [ [ " case is_" ++ f ++ ":" +prPrintRule r@(Rule fun _ _ _) = unless (isCoercion fun) $ concat + [ [ " case is_" ++ fnm ++ ":" , " if (_i_ > " ++ show p ++ ") renderC(_L_PAREN);" ] - , map (prPrintCat f) $ numVars cats + , map (" " ++) $ prPrintRule_ pre r , [ " if (_i_ > " ++ show p ++ ") renderC(_R_PAREN);" , " break;" , "" ] ] where - f = funName fun - p = precRule r -prPrintRule _ = [] + p = precRule r + fnm = funName fun + pre = concat [ "p->u.", map toLower fnm, "_." ] +-- | Only render the rhs (items) of a rule. + +prPrintRule_ :: IsFun a => String -> Rul a -> [String] +prPrintRule_ pre (Rule _ _ items _) = map (prPrintItem pre) $ numVars items + -- | This goes on to recurse to the instance variables. -prPrintCat :: String -> Either (Cat, Doc) String -> String -prPrintCat fnm = \case - Right t -> " " ++ render (renderX t) ++ ";" +prPrintItem :: String -> Either (Cat, Doc) String -> String +prPrintItem pre = \case + Right t -> render (renderX t) ++ ";" Left (cat, nt) -> concat - [ " pp" + [ "pp" , maybe (identCat $ normCat cat) basicFunName $ maybeTokenCat cat - , "(p->u." - , map toLower fnm - , "_.", render nt, ", ", show (precCat cat), ");" + , "(", pre, render nt, ", ", show (precCat cat), ");" ] {- **** Abstract Syntax Tree Printer **** -} @@ -485,7 +496,7 @@ " {", concatMap prShowRule rules, " default:", - " fprintf(stderr, \"Error: bad kind field when showing " ++ show cat ++ "!\\n\");", + " fprintf(stderr, \"Error: bad kind field when showing " ++ catToStr cat ++ "!\\n\");", " exit(1);", " }", "}\n" @@ -551,15 +562,14 @@ -- | An extremely simple @renderC@ for terminals. prRender :: String -prRender = unlines - [ +prRender = unlines $ concat + [ [ "/* You may wish to change the renderC functions */", "void renderC(Char c)", "{", " if (c == '{')", " {", - " bufAppendC('\\n');", - " indent();", + " onEmptyLine();", " bufAppendC(c);", " _n_ = _n_ + INDENT_WIDTH;", " bufAppendC('\\n');", @@ -569,30 +579,27 @@ " bufAppendC(c);", " else if (c == ')' || c == ']')", " {", - " backup();", + " removeTrailingWhitespace();", " bufAppendC(c);", " bufAppendC(' ');", " }", " else if (c == '}')", " {", - " int t;", " _n_ = _n_ - INDENT_WIDTH;", - " for(t=0; t= 0)", " bufAppendC(' ');", "}", + "", "void backup(void)", "{", " if (cur_ && buf_[cur_ - 1] == ' ')", " buf_[--cur_] = 0;", - "}" + "}", + "" + ] + , [ "void removeTrailingSpaces()" + , "{" + , " while (cur_ && buf_[cur_ - 1] == ' ') --cur_;" + , " buf_[cur_] = 0;" + , "}" + , "" + , "void removeTrailingWhitespace()" + , "{" + , " while (cur_ && (buf_[cur_ - 1] == ' ' || buf_[cur_ - 1] == '\\n')) --cur_;" + , " buf_[cur_] = 0;" + , "}" + , "" + , "void onEmptyLine()" + , "{" + , " removeTrailingSpaces();" + , " if (cur_ && buf_[cur_ - 1 ] != '\\n') bufAppendC('\\n');" + , " indent();" + , "}" + ] ] diff --git a/src/BNFC/Backend/C/CFtoCSkel.hs b/src/BNFC/Backend/C/CFtoCSkel.hs --- a/src/BNFC/Backend/C/CFtoCSkel.hs +++ b/src/BNFC/Backend/C/CFtoCSkel.hs @@ -165,32 +165,33 @@ member = map toLower ecl -- | Visits all the instance variables of a category. --- >>> let ab = Cat "ab" --- >>> prPrintRule (Rule "abc" undefined [Left ab, Left ab] Parsable) --- case is_abc: --- /* Code for abc Goes Here */ --- visitab(p->u.abc_.ab_1); --- visitab(p->u.abc_.ab_2); +-- >>> let ab = Cat "Ab" +-- >>> prPrintRule (Rule "Abc" undefined [Left ab, Left ab] Parsable) +-- case is_Abc: +-- /* Code for Abc Goes Here */ +-- visitAb(p->u.abc_.ab_1); +-- visitAb(p->u.abc_.ab_2); -- break; -- --- >>> let ab = TokenCat "ab" --- >>> prPrintRule (Rule "abc" undefined [Left ab] Parsable) --- case is_abc: --- /* Code for abc Goes Here */ +-- >>> let ab = TokenCat "Ab" +-- >>> prPrintRule (Rule "Abc" undefined [Left ab] Parsable) +-- case is_Abc: +-- /* Code for Abc Goes Here */ -- visitAb(p->u.abc_.ab_); -- break; -- --- >>> prPrintRule (Rule "abc" undefined [Left ab, Left ab] Parsable) --- case is_abc: --- /* Code for abc Goes Here */ +-- >>> prPrintRule (Rule "Abc" undefined [Left ab, Left ab] Parsable) +-- case is_Abc: +-- /* Code for Abc Goes Here */ -- visitAb(p->u.abc_.ab_1); -- visitAb(p->u.abc_.ab_2); -- break; -- prPrintRule :: Rule -> Doc prPrintRule (Rule f _c cats _) - | isCoercion f = "" - | otherwise = nest 2 $ vcat + | isCoercion f = empty + | isDefinedRule f = empty + | otherwise = nest 2 $ vcat [ text $ "case is_" ++ fun ++ ":" , nest 2 (vcat [ "/* Code for " <> text fun <> " Goes Here */" diff --git a/src/BNFC/Backend/C/CFtoFlexC.hs b/src/BNFC/Backend/C/CFtoFlexC.hs --- a/src/BNFC/Backend/C/CFtoFlexC.hs +++ b/src/BNFC/Backend/C/CFtoFlexC.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {- @@ -15,6 +17,7 @@ module BNFC.Backend.C.CFtoFlexC ( cf2flex + , ParserMode(..), parserName, parserPackage, cParser, stlParser, parserHExt , preludeForBuffer -- C code defining a buffer for lexing string literals. , cMacros -- Lexer definitions. , commentStates -- Stream of names for lexer states for comments. @@ -23,55 +26,101 @@ , lexChars -- Lexing rules for character literals. ) where -import Prelude hiding ((<>)) -import Data.Bifunctor (first) -import Data.List (isInfixOf) -import Data.Maybe (fromMaybe) +import Prelude hiding ( (<>) ) +import Data.Bifunctor ( first ) +import Data.Char ( isAlphaNum, isAscii ) +import Data.List ( isInfixOf ) +import Data.Maybe ( fromMaybe, maybeToList ) import qualified Data.Map as Map +import System.FilePath ( (<.>) ) import BNFC.CF +import BNFC.Backend.C.Common ( posixC ) import BNFC.Backend.C.RegToFlex import BNFC.Backend.Common.NamedVariables +import BNFC.Backend.CPP.STL.STLUtils ( nsDefine, nsString ) +import BNFC.Options ( InPackage ) import BNFC.PrettyPrint -import BNFC.Utils (cstring, unless, when) +import BNFC.Utils ( cstring, symbolToName, unless, when, whenJust ) +data ParserMode + = CParser Bool String -- ^ @C@ (@False@) or @C++ no STL@ (@True@) mode, with @name@ to use as prefix. + | CppParser InPackage String -- ^ @C++@ mode, with optional package name + +parserName :: ParserMode -> String +parserName = \case + CParser _ n -> n + CppParser p n -> fromMaybe n p + +parserPackage :: ParserMode -> InPackage +parserPackage = \case + CParser _ _ -> Nothing + CppParser p _ -> p + +cParser :: ParserMode -> Bool +cParser = \case + CParser b _ -> not b + CppParser _ _ -> False + +stlParser :: ParserMode -> Bool +stlParser = \case + CParser _ _ -> False + CppParser _ _ -> True + +parserHExt :: ParserMode -> String +parserHExt = \case + CParser b _ -> if b then "H" else "h" + CppParser _ _ -> "H" + -- | Entrypoint. -cf2flex :: String -> CF -> (String, SymMap) -- The environment is reused by the parser. -cf2flex name cf = (, env) $ unlines - [ prelude stringLiterals name +cf2flex :: ParserMode -> CF -> (String, SymMap) -- The environment is reused by the parser. +cf2flex mode cf = (, env) $ unlines + [ prelude stringLiterals mode , cMacros cf - , lexSymbols env0 - , restOfFlex cf env + , lexSymbols env1 + , restOfFlex (parserPackage mode) cf env + , footer -- mode ] where - env = Map.fromList env1 - env0 = makeSymEnv (cfgSymbols cf ++ reservedWords cf) [0 :: Int ..] - env1 = map (first Keyword )env0 ++ makeSymEnv (map Tokentype $ tokenNames cf) [length env0 ..] - makeSymEnv = zipWith $ \ s n -> (s, "_SYMB_" ++ show n) + env = Map.fromList env2 + env0 = makeSymEnv (cfgSymbols cf) [0 :: Int ..] + env1 = env0 ++ makeKwEnv (reservedWords cf) [length env0 ..] + env2 = map (first Keyword) env1 ++ map (\ x -> (Tokentype x, "T_" ++ x)) (tokenNames cf) + makeSymEnv = zipWith $ \ s n -> (s, '_' : fromMaybe ("SYMB_" ++ show n) (symbolToName s)) + makeKwEnv = zipWith $ \ s n -> (s, "_KW_" ++ if all (\ c -> isAlphaNum c && isAscii c) s then s else show n) stringLiterals = isUsedCat cf (TokenCat catString) -prelude :: Bool -> String -> String -prelude stringLiterals name = unlines $ concat +prelude :: Bool -> ParserMode -> String +prelude stringLiterals mode = unlines $ concat [ [ "/* -*- c -*- This FLex file was machine-generated by the BNF converter */" + , "" -- noinput and nounput are most often unused -- https://stackoverflow.com/questions/39075510/option-noinput-nounput-what-are-they-for , "%option noyywrap noinput nounput" - , "%top{" - , "/* strdup was not in the ISO C standard before 6/2019 (C2x), but in POSIX 1003.1." - , " * See: https://en.cppreference.com/w/c/experimental/dynamic/strdup" - , " * Setting _POSIX_C_SOURCE to 200809L activates strdup in string.h." - , " */" + , "%option reentrant bison-bridge bison-locations" + , "" + ] + , when stringLiterals + [ "/* Additional data for the lexer: a buffer for lexing string literals. */" + , "%option extra-type=\"Buffer\"" + , "" + ] + , maybeToList $ ("%option prefix=\"" ++) . (++ "\"" ) <$> parserPackage mode + , when (cParser mode) $ concat -- The following #define needs to be at the top before the automatic #include - , "#define _POSIX_C_SOURCE 200809L" - , "}" - , "%{" - , "#define yylval " ++ name ++ "lval" - , "#define yylloc " ++ name ++ "lloc" - , "#define init_lexer " ++ name ++ "_init_lexer" - , "#include \"Parser.h\"" + [ [ "%top{" ] + , posixC + , [ "}" ] + ] + , [ "%{" + , "#include \"" ++ ("Absyn" <.> h) ++ "\"" + , "#include \"" ++ ("Bison" <.> h) ++ "\"" , "" ] - , when stringLiterals $ preludeForBuffer "Buffer.h" + , [ "#define initialize_lexer " ++ parserName mode ++ "_initialize_lexer" + , "" + ] + , when stringLiterals $ preludeForBuffer $ "Buffer" <.> h -- https://www.gnu.org/software/bison/manual/html_node/Token-Locations.html -- Flex is responsible for keeping tracking of the yylloc for Bison. -- Flex also doesn't do this automatically so we need this function @@ -90,11 +139,13 @@ , " }" , " }" , "}" - , "#define YY_USER_ACTION update_loc(&yylloc, yytext);" + , "#define YY_USER_ACTION update_loc(yylloc, yytext);" , "" , "%}" ] ] + where + h = parserHExt mode -- | Part of the lexer prelude needed when string literals are to be lexed. -- Defines an interface to the Buffer. @@ -108,7 +159,7 @@ , "#define LITERAL_BUFFER_INITIAL_SIZE 1024" , "" , "/* The pointer to the literal buffer. */" - , "static Buffer literal_buffer = NULL;" + , "#define literal_buffer yyextra" , "" , "/* Initialize the literal buffer. */" , "#define LITERAL_BUFFER_CREATE() literal_buffer = newBuffer(LITERAL_BUFFER_INITIAL_SIZE)" @@ -139,7 +190,7 @@ , "DIGIT [0-9]" , "IDENT [a-zA-Z0-9'_]" , unwords $ concat - [ [ "%START YYINITIAL CHAR CHARESC CHAREND STRING ESCAPED" ] + [ [ "%START CHAR CHARESC CHAREND STRING ESCAPED" ] , take (numberOfBlockCommentForms cf) commentStates ] , "" @@ -150,56 +201,53 @@ lexSymbols ss = concatMap transSym ss where transSym (s,r) = - "\"" ++ s' ++ "\" \t return " ++ r ++ ";\n" + "\"" ++ s' ++ "\" \t return " ++ r ++ ";\n" where s' = escapeChars s -restOfFlex :: CF -> SymMap -> String -restOfFlex cf env = unlines $ concat - [ [ render $ lexComments Nothing (comments cf) +restOfFlex :: InPackage -> CF -> SymMap -> String +restOfFlex inPackage cf env = unlines $ concat + [ [ render $ lexComments $ comments cf , "" ] , userDefTokens , ifC catString $ lexStrings "yylval" "_STRING_" "_ERROR_" , ifC catChar $ lexChars "yylval" "_CHAR_" - , ifC catDouble [ "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t yylval._double = atof(yytext); return _DOUBLE_;" ] - , ifC catInteger [ "{DIGIT}+ \t yylval._int = atoi(yytext); return _INTEGER_;" ] - , ifC catIdent [ "{LETTER}{IDENT}* \t yylval._string = strdup(yytext); return _IDENT_;" ] - , [ "[ \\t\\r\\n\\f] \t /* ignore white space. */;" - , ". \t return _ERROR_;" + , ifC catDouble [ "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t yylval->_double = atof(yytext); return _DOUBLE_;" ] + , ifC catInteger [ "{DIGIT}+ \t yylval->_int = atoi(yytext); return _INTEGER_;" ] + , ifC catIdent [ "{LETTER}{IDENT}* \t yylval->_string = strdup(yytext); return _IDENT_;" ] + , [ "[ \\t\\r\\n\\f] \t /* ignore white space. */;" + , ". \t return _ERROR_;" , "" , "%% /* Initialization code. */" - , "" ] - , footer ] where ifC cat s = if isUsedCat cf (TokenCat cat) then s else [] userDefTokens = - [ "" ++ printRegFlex exp ++ - " \t yylval._string = strdup(yytext); return " ++ sName name ++ ";" + [ "" ++ printRegFlex exp ++ + " \t yylval->_string = strdup(yytext); return " ++ sName name ++ ";" | (name, exp) <- tokenPragmas cf ] where sName n = fromMaybe n $ Map.lookup (Tokentype n) env - footer = - [ - "void init_lexer(FILE *inp)", - "{", - " yyrestart(inp);", - " yylloc.first_line = 1;", - " yylloc.first_column = 1;", - " yylloc.last_line = 1;", - " yylloc.last_column = 1;", - " BEGIN YYINITIAL;", - "}" + +footer :: String +footer = unlines + [ "yyscan_t initialize_lexer(FILE *inp)" + , "{" + , " yyscan_t scanner;" + , " if (yylex_init_extra(NULL, &scanner)) return 0;" + , " if (inp) yyrestart(inp, scanner);" + , " return scanner;" + , "}" ] -- | Lexing of strings, converting escaped characters. lexStrings :: String -> String -> String -> [String] lexStrings yylval stringToken errorToken = - [ "\"\\\"\" \t LITERAL_BUFFER_CREATE(); BEGIN STRING;" + [ "\"\\\"\" \t LITERAL_BUFFER_CREATE(); BEGIN STRING;" , "\\\\ \t BEGIN ESCAPED;" - , "\\\" \t " ++ yylval ++ "._string = LITERAL_BUFFER_HARVEST(); BEGIN YYINITIAL; return " ++ stringToken ++ ";" + , "\\\" \t " ++ yylval ++ "->_string = LITERAL_BUFFER_HARVEST(); BEGIN INITIAL; return " ++ stringToken ++ ";" , ". \t LITERAL_BUFFER_APPEND_CHAR(yytext[0]);" , "n \t LITERAL_BUFFER_APPEND_CHAR('\\n'); BEGIN STRING;" , "\\\" \t LITERAL_BUFFER_APPEND_CHAR('\"'); BEGIN STRING;" @@ -212,13 +260,13 @@ -- | Lexing of characters, converting escaped characters. lexChars :: String -> String -> [String] lexChars yylval charToken = - [ "\"'\" \tBEGIN CHAR;" + [ "\"'\" \tBEGIN CHAR;" , "\\\\ \t BEGIN CHARESC;" - , "[^'] \t BEGIN CHAREND; " ++ yylval ++ "._char = yytext[0]; return " ++ charToken ++ ";" - , "n \t BEGIN CHAREND; " ++ yylval ++ "._char = '\\n'; return " ++ charToken ++ ";" - , "t \t BEGIN CHAREND; " ++ yylval ++ "._char = '\\t'; return " ++ charToken ++ ";" - , ". \t BEGIN CHAREND; " ++ yylval ++ "._char = yytext[0]; return " ++ charToken ++ ";" - , "\"'\" \t BEGIN YYINITIAL;" + , "[^'] \t BEGIN CHAREND; " ++ yylval ++ "->_char = yytext[0]; return " ++ charToken ++ ";" + , "n \t BEGIN CHAREND; " ++ yylval ++ "->_char = '\\n'; return " ++ charToken ++ ";" + , "t \t BEGIN CHAREND; " ++ yylval ++ "->_char = '\\t'; return " ++ charToken ++ ";" + , ". \t BEGIN CHAREND; " ++ yylval ++ "->_char = yytext[0]; return " ++ charToken ++ ";" + , "\"'\" \t BEGIN INITIAL;" ] -- --------------------------------------------------------------------------- @@ -232,15 +280,15 @@ -- lexSingleComment or lexMultiComment on each comment delimiter or pair of -- delimiters. -- --- >>> lexComments (Just "myns.") ([("{-","-}")],["--"]) --- "--"[^\n]* /* skip */; /* BNFC: comment "--" */ --- "{-" BEGIN COMMENT; /* BNFC: block comment "{-" "-}" */ --- "-}" BEGIN YYINITIAL; +-- >>> lexComments ([("{-","-}")],["--"]) +-- "--"[^\n]* /* skip */; /* BNFC: comment "--" */ +-- "{-" BEGIN COMMENT; /* BNFC: block comment "{-" "-}" */ +-- "-}" BEGIN INITIAL; -- . /* skip */; -- [\n] /* skip */; -lexComments :: Maybe String -> ([(String, String)], [String]) -> Doc -lexComments _ (m,s) = vcat $ concat - [ map lexSingleComment s +lexComments :: ([(String, String)], [String]) -> Doc +lexComments (m,s) = vcat $ concat + [ map lexSingleComment s , zipWith lexMultiComment m commentStates ] @@ -254,13 +302,13 @@ -- comment. -- -- >>> lexSingleComment "--" --- "--"[^\n]* /* skip */; /* BNFC: comment "--" */ +-- "--"[^\n]* /* skip */; /* BNFC: comment "--" */ -- -- >>> lexSingleComment "\"" --- "\""[^\n]* /* skip */; /* BNFC: comment "\"" */ +-- "\""[^\n]* /* skip */; /* BNFC: comment "\"" */ lexSingleComment :: String -> Doc lexSingleComment c = - "" <> cstring c <> "[^\\n]*" + "" <> cstring c <> "[^\\n]*" <+> "/* skip */;" <+> unless (containsCCommentMarker c) ("/* BNFC: comment" <+> cstring c <+> "*/") @@ -276,22 +324,22 @@ -- with another. However this seems rare. -- -- >>> lexMultiComment ("{-", "-}") "COMMENT" --- "{-" BEGIN COMMENT; /* BNFC: block comment "{-" "-}" */ --- "-}" BEGIN YYINITIAL; +-- "{-" BEGIN COMMENT; /* BNFC: block comment "{-" "-}" */ +-- "-}" BEGIN INITIAL; -- . /* skip */; -- [\n] /* skip */; -- -- >>> lexMultiComment ("\"'", "'\"") "COMMENT" --- "\"'" BEGIN COMMENT; /* BNFC: block comment "\"'" "'\"" */ --- "'\"" BEGIN YYINITIAL; +-- "\"'" BEGIN COMMENT; /* BNFC: block comment "\"'" "'\"" */ +-- "'\"" BEGIN INITIAL; -- . /* skip */; -- [\n] /* skip */; lexMultiComment :: (String, String) -> String -> Doc lexMultiComment (b,e) comment = vcat - [ "" <> cstring b <+> "BEGIN" <+> text comment <> ";" + [ "" <> cstring b <+> "BEGIN" <+> text comment <> ";" <+> unless (containsCCommentMarker b || containsCCommentMarker e) ("/* BNFC: block comment" <+> cstring b <+> cstring e <+> "*/") - , commentTag <> cstring e <+> "BEGIN YYINITIAL;" + , commentTag <> cstring e <+> "BEGIN INITIAL;" , commentTag <> ". /* skip */;" , commentTag <> "[\\n] /* skip */;" ] diff --git a/src/BNFC/Backend/C/Common.hs b/src/BNFC/Backend/C/Common.hs new file mode 100644 --- /dev/null +++ b/src/BNFC/Backend/C/Common.hs @@ -0,0 +1,18 @@ +-- | Common definitions for the modules of the C backend. + +module BNFC.Backend.C.Common + ( posixC + ) where + +import Prelude + +-- | Switch C to language variant that has @strdup@. + +posixC :: [String] +posixC = + [ "/* strdup was not in the ISO C standard before 6/2019 (C2x), but in POSIX 1003.1." + , " * See: https://en.cppreference.com/w/c/experimental/dynamic/strdup" + , " * Setting _POSIX_C_SOURCE to 200809L activates strdup in string.h." + , " */" + , "#define _POSIX_C_SOURCE 200809L" + ] diff --git a/src/BNFC/Backend/CPP/Common.hs b/src/BNFC/Backend/CPP/Common.hs new file mode 100644 --- /dev/null +++ b/src/BNFC/Backend/CPP/Common.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE LambdaCase #-} + +-- | Common to the C++ backends. + +module BNFC.Backend.CPP.Common where + +import Data.Char ( isUpper ) +import Data.List ( nub, intercalate ) + +import BNFC.CF +import BNFC.TypeChecker + +import BNFC.Backend.CPP.Naming + +-- | C++ code for the @define@d constructors. +-- +-- @definedRules Nothing@ only prints the header. +definedRules :: Maybe ListConstructors -> CF -> String -> String +definedRules mlc cf banner + | null theLines = [] + | otherwise = unlines $ banner : "" : theLines + where + theLines = map rule $ definitions cf + + ctx = buildContext cf + + list = LC + { nil = const ("[]", dummyType) + , cons = \ t -> ("List" ++ unBase t, dummyType) + } + where + unBase (ListT t) = unBase t + unBase (BaseT x) = x + + rule (Define f args e t) = + case mlc of + Nothing -> header ++ ";" + Just lc -> unlines + [ header ++ " {" + , " return " ++ cppExp lc (map fst args) e ++ ";" + , "}" + ] + where + header = cppType t ++ " " ++ sanitizeCpp (funName f) ++ "(" ++ + intercalate ", " (map cppArg args) ++ ")" + + cppType :: Base -> String + cppType (ListT (BaseT x)) = "List" ++ x ++ "*" + cppType (ListT t) = cppType t ++ "*" + cppType (BaseT x) + | x `elem` baseTokenCatNames = x + | isToken x ctx = "String" + | otherwise = x ++ "*" + + cppArg :: (String, Base) -> String + cppArg (x,t) = cppType t ++ " " ++ x ++ "_" + + cppExp :: ListConstructors -> [String] -> Exp -> String + cppExp (LC nil cons) args = loop + where + loop = \case + App "[]" (FunT [] (ListT t)) [] -> fst $ nil t + App "(:)" (FunT _ (ListT t)) es -> call (fst $ cons t) es + Var x -> x ++ "_" -- argument + App t _ [e] + | isToken t ctx -> loop e + App x _ es + | isUpper (head x) -> call ("new " ++ x) es + | x `elem` args -> call (x ++ "_") es + | otherwise -> call (sanitizeCpp x) es + LitInt n -> show n + LitDouble x -> show x + LitChar c -> show c + LitString s -> show s + + call x es = x ++ "(" ++ intercalate ", " (map loop es) ++ ")" diff --git a/src/BNFC/Backend/CPP/Makefile.hs b/src/BNFC/Backend/CPP/Makefile.hs --- a/src/BNFC/Backend/CPP/Makefile.hs +++ b/src/BNFC/Backend/CPP/Makefile.hs @@ -3,16 +3,16 @@ import BNFC.Backend.Common.Makefile import BNFC.PrettyPrint -makefile :: String -> String -> Doc -makefile name basename = vcat +makefile :: String -> String -> String -> Doc +makefile prefix name basename = vcat [ mkVar "CC" "g++ -g" , mkVar "CCFLAGS" "--ansi -W -Wall -Wno-unused-parameter -Wno-unused-function -Wno-unneeded-internal-declaration" , "" , mkVar "FLEX" "flex" - , mkVar "FLEX_OPTS" ("-P" ++ name) + , mkVar "FLEX_OPTS" ("-P" ++ prefix) , "" , mkVar "BISON" "bison" - , mkVar "BISON_OPTS" ("-t -p" ++ name) + , mkVar "BISON_OPTS" ("-t -p" ++ prefix) , "" , mkVar "OBJS" "Absyn.o Buffer.o Lexer.o Parser.o Printer.o" , "" @@ -29,7 +29,7 @@ [ "Absyn.C", "Absyn.H" , "Buffer.C", "Buffer.H" , "Test.C" - , "Parser.C", "Parser.H", "ParserError.H", name ++ ".y" + , "Bison.H", "Parser.C", "Parser.H", "ParserError.H", name ++ ".y" , "Lexer.C", name ++ ".l" , "Skeleton.C", "Skeleton.H" , "Printer.C", "Printer.H" @@ -45,12 +45,12 @@ , mkRule "Buffer.o" [ "Buffer.C", "Buffer.H" ] [ "${CC} ${CCFLAGS} -c Buffer.C " ] , mkRule "Lexer.C" [ name ++ ".l" ] - [ "${FLEX} -oLexer.C " ++ name ++ ".l" ] - , mkRule "Parser.C" [ name ++ ".y" ] - [ "${BISON} " ++ name ++ ".y -o Parser.C" ] - , mkRule "Lexer.o" [ "Lexer.C", "Parser.H" ] + [ "${FLEX} ${FLEX_OPTS} -oLexer.C " ++ name ++ ".l" ] + , mkRule "Parser.C Bison.H" [ name ++ ".y" ] + [ "${BISON} ${BISON_OPTS} " ++ name ++ ".y -o Parser.C" ] + , mkRule "Lexer.o" [ "Lexer.C", "Bison.H" ] [ "${CC} ${CCFLAGS} -c Lexer.C " ] - , mkRule "Parser.o" [ "Parser.C", "Absyn.H" ] + , mkRule "Parser.o" [ "Parser.C", "Absyn.H", "Bison.H" ] [ "${CC} ${CCFLAGS} -c Parser.C" ] , mkRule "Printer.o" [ "Printer.C", "Printer.H", "Absyn.H" ] [ "${CC} ${CCFLAGS} -c Printer.C" ] diff --git a/src/BNFC/Backend/CPP/Naming.hs b/src/BNFC/Backend/CPP/Naming.hs --- a/src/BNFC/Backend/CPP/Naming.hs +++ b/src/BNFC/Backend/CPP/Naming.hs @@ -19,3 +19,9 @@ mkVariable :: String -> String mkVariable = mkName cppReservedWords SnakeCase + +sanitizeC :: String -> String +sanitizeC = mkName cReservedWords OrigCase + +sanitizeCpp :: String -> String +sanitizeCpp = mkName cppReservedWords OrigCase diff --git a/src/BNFC/Backend/CPP/NoSTL.hs b/src/BNFC/Backend/CPP/NoSTL.hs --- a/src/BNFC/Backend/CPP/NoSTL.hs +++ b/src/BNFC/Backend/CPP/NoSTL.hs @@ -15,11 +15,10 @@ import BNFC.Options import BNFC.Backend.Base import BNFC.Backend.C (bufferH, bufferC) -import BNFC.Backend.C.CFtoBisonC (unionBuiltinTokens) +import BNFC.Backend.C.CFtoBisonC (cf2Bison) +import BNFC.Backend.C.CFtoFlexC (cf2flex, ParserMode(..)) import BNFC.Backend.CPP.Makefile import BNFC.Backend.CPP.NoSTL.CFtoCPPAbs -import BNFC.Backend.CPP.NoSTL.CFtoFlex -import BNFC.Backend.CPP.NoSTL.CFtoBison import BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL import BNFC.Backend.CPP.PrettyPrinter import qualified BNFC.Backend.Common.Makefile as Makefile @@ -31,9 +30,9 @@ mkfile "Absyn.C" cfile mkfile "Buffer.H" bufferH mkfile "Buffer.C" $ bufferC "Buffer.H" - let (flex, env) = cf2flex Nothing name cf + let (flex, env) = cf2flex parserMode cf mkfile (name ++ ".l") flex - let bison = cf2Bison name cf env + let bison = cf2Bison(linenumbers opts) parserMode cf env mkfile (name ++ ".y") bison let header = mkHeaderFile cf (allParserCats cf) (toList $ allEntryPoints cf) (Map.elems env) mkfile "Parser.H" header @@ -44,9 +43,17 @@ mkfile "Printer.H" prinH mkfile "Printer.C" prinC mkfile "Test.C" (cpptest cf) - Makefile.mkMakefile opts $ makefile name - where name = lang opts - + Makefile.mkMakefile opts $ makefile prefix name + where + name :: String + name = lang opts + -- The prefix is a string used by flex and bison + -- that is prepended to generated function names. + -- It should be a valid C identifier. + prefix :: String + prefix = snakeCase_ name ++ "_" + parserMode :: ParserMode + parserMode = CParser True prefix cpptest :: CF -> String cpptest cf = @@ -113,6 +120,7 @@ " PrintAbsyn *p = new PrintAbsyn();", " printf(\"%s\\n\\n\", p->print(parse_tree));", " }", + " delete(parse_tree);", " return 0;", " }", " return 1;", @@ -128,18 +136,7 @@ [ [ "#ifndef PARSER_HEADER_FILE" , "#define PARSER_HEADER_FILE" , "" - ] - , map mkForwardDec $ nub $ map normCat cats - , [ "typedef union" - , "{" - ] - , map (" " ++) unionBuiltinTokens - , concatMap mkVar cats - , [ "} YYSTYPE;" - , "" - , "#define _ERROR_ 258" - , mkDefines (259 :: Int) env - , "extern YYSTYPE yylval;" + , "#include \"Absyn.H\"" , "" ] , map mkFunc eps @@ -148,24 +145,4 @@ ] ] where - mkForwardDec s = "class " ++ identCat s ++ ";" - mkVar s | normCat s == s = [ " " ++ identCat s ++"*" +++ map toLower (identCat s) ++ "_;" ] - mkVar _ = [] - mkDefines n [] = mkString n - mkDefines n (s:ss) = "#define " ++ s +++ show n ++ "\n" ++ mkDefines (n+1) ss - mkString n = if isUsedCat cf (TokenCat catString) - then ("#define _STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) - else mkChar n - mkChar n = if isUsedCat cf (TokenCat catChar) - then ("#define _CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) - else mkInteger n - mkInteger n = if isUsedCat cf (TokenCat catInteger) - then ("#define _INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) - else mkDouble n - mkDouble n = if isUsedCat cf (TokenCat catDouble) - then ("#define _DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) - else mkIdent n - mkIdent n = if isUsedCat cf (TokenCat catIdent) - then "#define _IDENT_ " ++ show n ++ "\n" - else "" mkFunc s = identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);" diff --git a/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs b/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs deleted file mode 100644 --- a/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs +++ /dev/null @@ -1,226 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - BNF Converter: Bison generator - Copyright (C) 2004 Author: Michael Pellauer - - Description : This module generates the Bison input file. - Note that because of the way bison stores results - the programmer can increase performance by limiting - the number of entry points in their grammar. - - Author : Michael Pellauer - Created : 6 August, 2003 --} - -module BNFC.Backend.CPP.NoSTL.CFtoBison (cf2Bison) where - -import Data.Char ( toLower ) -import Data.Foldable ( toList ) -import Data.List ( intersperse, nub ) -import Data.Maybe ( fromMaybe ) -import qualified Data.Map as Map - -import BNFC.CF -import BNFC.Backend.Common.NamedVariables hiding (varName) -import BNFC.Backend.C.CFtoBisonC - ( resultName, specialToks, startSymbol, typeName, varName ) -import BNFC.Backend.CPP.STL.CFtoBisonSTL ( tokens, union, definedRules ) -import BNFC.PrettyPrint -import BNFC.Utils ( (+++) ) - ---This follows the basic structure of CFtoHappy. - --- Type declarations -type Rules = [(NonTerminal,[(Pattern,Action)])] -type Pattern = String -type Action = String -type MetaVar = String - ---The environment comes from the CFtoFlex -cf2Bison :: String -> CF -> SymMap -> String -cf2Bison name cf env - = unlines - [header name cf, - render $ union Nothing (allParserCats cf), - "%token _ERROR_", - tokens user env, - declarations cf, - startSymbol cf, - specialToks cf, - "%%", - prRules (rulesForBison name cf env) - ] - where - user = fst (unzip (tokenPragmas cf)) - -header :: String -> CF -> String -header name cf = unlines - [ "/* This Bison file was machine-generated by BNFC */" - , "%{" - , "#include " - , "#include " - , "#include " - , "#include \"Absyn.H\"" - , "" - , "#define YYMAXDEPTH 10000000" -- default maximum stack size is 10000, but right-recursion needs O(n) stack - , "" - , "int yyparse(void);" - , "int yylex(void);" - , "int yy_mylinenumber;" --- hack to get line number. AR 2006 - , "void initialize_lexer(FILE * inp);" - , "int yywrap(void)" - , "{" - , " return 1;" - , "}" - , "void yyerror(const char *str)" - , "{" - , " extern char *yytext;" - , " fprintf(stderr,\"error: line %d: %s at %s\\n\", " - , " yy_mylinenumber + 1, str, yytext);" - , "}" - , "" - , definedRules cf - , concatMap reverseList $ filter isList $ allParserCatsNorm cf - , unlines $ map parseResult dats - , unlines $ map (parseMethod cf name) eps - , "%}" - ] - where - eps = toList $ allEntryPoints cf - dats = nub $ map normCat eps - - - --- | Generates declaration and initialization of the @YY_RESULT@ for a parser. --- --- Different parsers (for different precedences of the same category) --- share such a declaration. --- --- Expects a normalized category. -parseResult :: Cat -> String -parseResult cat = - "static " ++ cat' ++ "*" +++ resultName cat' +++ "= 0;" - where - cat' = identCat cat - - ---This generates a parser method for each entry point. -parseMethod :: CF -> String -> Cat -> String -parseMethod cf _ cat = unlines - [ - dat ++"* p" ++ par ++ "(FILE *inp)", - "{", - " initialize_lexer(inp);", - " if (yyparse())", - " { /* Failure */", - " return 0;", - " }", - " else", - " { /* Success */", - " return" +++ res ++ ";", - " }", - "}" - ] - where - dat = identCat (normCat cat) - par = identCat cat - res0 = resultName dat - revRes = "reverse" ++ dat ++ "(" ++ res0 ++ ")" - res = if cat `elem` cfgReversibleCats cf then revRes else res0 - ---This method generates list reversal functions for each list type. -reverseList :: Cat -> String -reverseList c = unlines - [ - c' ++ "* reverse" ++ c' ++ "(" ++ c' +++ "*l)", - "{", - " " ++ c' +++"*prev = 0;", - " " ++ c' +++"*tmp = 0;", - " while (l)", - " {", - " tmp = l->" ++ v ++ ";", - " l->" ++ v +++ "= prev;", - " prev = l;", - " l = tmp;", - " }", - " return prev;", - "}" - ] - where - c' = identCat (normCat c) - v = (map toLower c') ++ "_" - ---declares non-terminal types. -declarations :: CF -> String -declarations cf = concatMap (typeNT cf) (allParserCats cf) - where --don't define internal rules - typeNT cf nt | rulesForCat cf nt /= [] = "%type <" ++ varName nt ++ "> " ++ identCat nt ++ "\n" - typeNT _ _ = "" - ---The following functions are a (relatively) straightforward translation ---of the ones in CFtoHappy.hs -rulesForBison :: String -> CF -> SymMap -> Rules -rulesForBison _ cf env = map mkOne $ ruleGroups cf where - mkOne (cat,rules) = constructRule cf env rules cat - --- For every non-terminal, we construct a set of rules. -constructRule :: CF -> SymMap -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) -constructRule cf env rules nt = (nt,[(p,(generateAction (ruleName r) b m) +++ result) | - r0 <- rules, - let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs - then (True,revSepListRule r0) - else (False,r0), - let (p,m) = generatePatterns cf env r]) - where - ruleName r = case funName $ funRule r of - "(:)" -> identCat (normCat nt) - "(:[])" -> identCat (normCat nt) - z -> z - revs = cfgReversibleCats cf - eps = allEntryPoints cf - isEntry nt = if elem nt eps then True else False - result = if isEntry nt then (resultName (identCat (normCat nt))) ++ "= $$;" else "" - --- Generates a string containing the semantic action. -generateAction :: Fun -> Bool -> [MetaVar] -> Action -generateAction f b ms = - if isCoercion f - then (unwords ms) ++ ";" - else if f == "[]" - then "0;" - else if isDefinedRule f - then concat [ f, "_", "(", concat $ intersperse ", " ms', ");" ] - else concat ["new ", f, "(", (concat (intersperse ", " ms')), ");"] - where - ms' = if b then reverse ms else ms - --- Generate patterns and a set of metavariables indicating --- where in the pattern the non-terminal -generatePatterns :: CF -> SymMap -> Rule -> (Pattern,[MetaVar]) -generatePatterns cf env r = case rhsRule r of - [] -> ("/* empty */",[]) - its -> (unwords (map mkIt its), metas its) - where - mkIt i = case i of - Left (TokenCat s) -> fromMaybe (typeName s) $ Map.lookup (Tokentype s) env - Left c -> identCat c - Right s -> fromMaybe s $ Map.lookup (Keyword s) env - metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 :: Int ..] its] - revIf c m = if (not (isConsFun (funRule r)) && elem c revs) - then ("reverse" ++ (identCat (normCat c)) ++ "(" ++ m ++ ")") - else m -- no reversal in the left-recursive Cons rule itself - revs = cfgReversibleCats cf - --- We have now constructed the patterns and actions, --- so the only thing left is to merge them into one string. - -prRules :: Rules -> String -prRules [] = [] -prRules ((_, []):rs) = prRules rs --internal rule -prRules ((nt,((p,a):ls)):rs) = - (unwords [nt', ":" , p, "{ $$ =", a, "}", "\n" ++ pr ls]) ++ ";\n" ++ prRules rs - where - nt' = identCat nt - pr [] = [] - pr ((p,a):ls) = (unlines [(concat $ intersperse " " [" |", p, "{ $$ =", a , "}"])]) ++ pr ls diff --git a/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs b/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs --- a/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs +++ b/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} {- BNF Converter: C++ abstract syntax generator @@ -18,13 +20,17 @@ import Prelude hiding ((<>)) +import Data.List ( findIndices, intersperse ) +import Data.Char ( toLower ) +import Text.PrettyPrint + import BNFC.CF -import BNFC.Utils((+++),(++++)) +import BNFC.TypeChecker ( ListConstructors(..) ) +import BNFC.Utils ( (+++), (++++) ) + import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Common.OOAbstract -import Data.List -import Data.Char(toLower) -import Text.PrettyPrint +import BNFC.Backend.CPP.Common --The result is two files (.H file, .C file) @@ -52,6 +58,9 @@ "/******************** Abstract Syntax Classes ********************/\n", concatMap (prDataH user) (getAbstractSyntax cf), "", + definedRules Nothing cf + "/******************** Defined Constructors ********************/", + "", "#endif" ] where @@ -67,7 +76,7 @@ --Prints interface classes for all categories. prDataH :: [UserDef] -> Data -> String prDataH user (cat, rules) = - case lookup (show cat) rules of + case lookup (catToStr cat) rules of Just _ -> concatMap (prRuleH user cat) rules Nothing -> if isList cat then concatMap (prRuleH user cat) rules @@ -125,7 +134,7 @@ c' = identCat (normCat c); mem = drop 4 c' memstar = if isBasic user mem then "" else "*" - super = if show c == fun then "Visitable" else identCat c + super = if catToStr c == fun then "Visitable" else identCat c prConstructorH :: Int -> [(String, b)] -> String prConstructorH _ [] = "" prConstructorH n [(t,_)] = t +++ optstar t ++ "p" ++ show n @@ -218,10 +227,14 @@ mkCFile cf = unlines [ header, - concatMap (prDataC user) (getAbstractSyntax cf) + concatMap (prDataC user) (getAbstractSyntax cf), + definedRules (Just $ LC nil cons) cf + "/******************** Defined Constructors ********************/" ] where - user = fst (unzip (tokenPragmas cf)) + nil _ = (,dummyType) $ "NULL" + cons t = (,dummyType) $ "new List" ++ identType t + user = map fst (tokenPragmas cf) header = unlines [ "//C++ Abstract Syntax Implementation generated by the BNF Converter.", diff --git a/src/BNFC/Backend/CPP/NoSTL/CFtoFlex.hs b/src/BNFC/Backend/CPP/NoSTL/CFtoFlex.hs deleted file mode 100644 --- a/src/BNFC/Backend/CPP/NoSTL/CFtoFlex.hs +++ /dev/null @@ -1,204 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE TupleSections #-} - -{- - BNF Converter: Flex generator - Copyright (C) 2004 Author: Michael Pellauer - Copyright (C) 2020 Andreas Abel - - Description : This module generates the Flex file. It is - similar to JLex but with a few peculiarities. - - Author : Michael Pellauer - Created : 5 August, 2003 - Modified : 22 August, 2006 by Aarne Ranta --} - -module BNFC.Backend.CPP.NoSTL.CFtoFlex (cf2flex) where - -import Prelude hiding ((<>)) -import Data.Bifunctor (first) -import Data.Maybe (fromMaybe) -import qualified Data.Map as Map - -import BNFC.CF -import BNFC.Backend.C.CFtoFlexC (preludeForBuffer, cMacros, commentStates, lexChars, lexStrings) -import BNFC.Backend.C.RegToFlex -import BNFC.Backend.Common.NamedVariables -import BNFC.Backend.CPP.STL.STLUtils -import BNFC.PrettyPrint -import BNFC.Utils (cstring, when) - ---The environment must be returned for the parser to use. -cf2flex :: Maybe String -> String -> CF -> (String, SymMap) -cf2flex inPackage _name cf = (, env) $ unlines - [ prelude stringLiterals inPackage - , cMacros cf - , lexSymbols env0 - , restOfFlex inPackage cf env - ] - where - env = Map.fromList env1 - env0 = makeSymEnv (cfgSymbols cf ++ reservedWords cf) [0 :: Int ..] - env1 = map (first Keyword) env0 ++ makeSymEnv (map Tokentype $ tokenNames cf) [length env0 ..] - makeSymEnv = zipWith $ \ s n -> (s, "_SYMB_" ++ show n) - stringLiterals = isUsedCat cf (TokenCat catString) - -prelude :: Bool -> Maybe String -> String -prelude stringLiterals inPackage = unlines $ concat - [ [ "/* This FLex file was machine-generated by the BNF converter */" ] - , maybe [] (\ ns -> [ "%option prefix=\"" ++ ns ++ "yy\"" ]) inPackage - , [ "%{" - , "#include " - , "#include \"Parser.H\"" - , "extern int " ++ nsString inPackage ++ "yy_mylinenumber ;" --- hack to get line number. AR 2006 - , "" - ] - , when stringLiterals $ preludeForBuffer "Buffer.H" - , [ "%}" ] - ] - -lexSymbols :: SymEnv -> String -lexSymbols ss = concatMap transSym ss - where - transSym (s,r) = - "\"" ++ s' ++ "\" \t return " ++ r ++ ";\n" - where - s' = escapeChars s - -restOfFlex :: Maybe String -> CF -> SymMap -> String -restOfFlex inPackage cf env = unlines $ concat - [ [ render $ lexComments inPackage (comments cf) - , "" - ] - , userDefTokens - , ifC catString $ lexStrings (ns ++ "yylval") (nsDefine inPackage "_STRING_") (nsDefine inPackage "_ERROR_") - , ifC catChar $ lexChars (ns ++ "yylval") (nsDefine inPackage "_CHAR_") - , ifC catDouble [ "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t " ++ ns ++ "yylval._double = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";" ] - , ifC catInteger [ "{DIGIT}+ \t " ++ ns ++ "yylval._int = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";" ] - , ifC catIdent [ "{LETTER}{IDENT}* \t " ++ ns ++ "yylval._string = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";" ] - , [ "\\n ++" ++ ns ++ "yy_mylinenumber ;" - , "[ \\t\\r\\n\\f] \t /* ignore white space. */;" - , ". \t return " ++ nsDefine inPackage "_ERROR_" ++ ";" - , "%%" - ] - , footer - ] - where - ifC cat s = if isUsedCat cf (TokenCat cat) then s else [] - ns = nsString inPackage - userDefTokens = - [ "" ++ printRegFlex exp ++ - " \t " ++ ns ++ "yylval._string = strdup(yytext); return " ++ sName name ++ ";" - | (name, exp) <- tokenPragmas cf - ] - where sName n = fromMaybe n $ Map.lookup (Tokentype n) env - footer = - [ "void " ++ ns ++ "initialize_lexer(FILE *inp) { yyrestart(inp); BEGIN YYINITIAL; }" - , "int yywrap(void) { return 1; }" - ] - - --- --------------------------------------------------------------------------- --- Comments - --- | Create flex rules for single-line and multi-lines comments. --- The first argument is an optional namespace (for C++); the second --- argument is the set of comment delimiters as returned by BNFC.CF.comments. --- --- This function is only compiling the results of applying either --- lexSingleComment or lexMultiComment on each comment delimiter or pair of --- delimiters. --- --- >>> lexComments (Just "myns.") ([("{-","-}")],["--"]) --- "--"[^\n]* ; // BNFC: comment "--"; --- "{-" BEGIN COMMENT; // BNFC: block comment "{-" "-}"; --- "-}" BEGIN YYINITIAL; --- . /* skip */; --- [\n] ++myns.yy_mylinenumber; -lexComments :: Maybe String -> ([(String, String)], [String]) -> Doc -lexComments ns (m,s) = vcat $ concat - [ map (lexSingleComment ns) s - , zipWith (lexMultiComment ns) m commentStates - ] - --- | Create a lexer rule for single-line comments. --- The first argument is -- an optional c++ namespace --- The second argument is the delimiter that marks the beginning of the --- comment. --- --- >>> lexSingleComment (Just "mypackage.") "--" --- "--"[^\n]* ; // BNFC: comment "--"; --- --- >>> lexSingleComment Nothing "--" --- "--"[^\n]* ; // BNFC: comment "--"; --- --- >>> lexSingleComment Nothing "\"" --- "\""[^\n]* ; // BNFC: comment "\""; -lexSingleComment :: Maybe String -> String -> Doc -lexSingleComment _ c = - "" <> cstring c <> "[^\\n]*" - <+> ";" - <+> "// BNFC: comment" <+> cstring c <> ";" - --- -- | Create a lexer rule for single-line comments. --- -- The first argument is -- an optional c++ namespace --- -- The second argument is the delimiter that marks the beginning of the --- -- comment. --- -- --- -- >>> lexSingleComment (Just "mypackage.") "--" --- -- "--"[^\n]*\n ++mypackage.yy_mylinenumber; // BNFC: comment "--"; --- -- --- -- >>> lexSingleComment Nothing "--" --- -- "--"[^\n]*\n ++yy_mylinenumber; // BNFC: comment "--"; --- -- --- -- >>> lexSingleComment Nothing "\"" --- -- "\""[^\n]*\n ++yy_mylinenumber; // BNFC: comment "\""; --- lexSingleComment :: Maybe String -> String -> Doc --- lexSingleComment ns c = --- "" <> cstring c <> "[^\\n]*\\n" --- <+> "++"<> text (fromMaybe "" ns)<>"yy_mylinenumber;" --- <+> "// BNFC: comment" <+> cstring c <> ";" - --- | Create a lexer rule for multi-lines comments. --- The first argument is -- an optional c++ namespace --- The second arguments is the pair of delimiter for the multi-lines comment: --- start deleminiter and end delimiter. --- There might be a possible bug here if a language includes 2 multi-line --- comments. They could possibly start a comment with one character and end it --- with another. However this seems rare. --- --- >>> lexMultiComment Nothing ("{-", "-}") "COMMENT" --- "{-" BEGIN COMMENT; // BNFC: block comment "{-" "-}"; --- "-}" BEGIN YYINITIAL; --- . /* skip */; --- [\n] ++yy_mylinenumber; --- --- >>> lexMultiComment (Just "foo.") ("{-", "-}") "COMMENT" --- "{-" BEGIN COMMENT; // BNFC: block comment "{-" "-}"; --- "-}" BEGIN YYINITIAL; --- . /* skip */; --- [\n] ++foo.yy_mylinenumber; --- --- >>> lexMultiComment Nothing ("\"'", "'\"") "COMMENT" --- "\"'" BEGIN COMMENT; // BNFC: block comment "\"'" "'\""; --- "'\"" BEGIN YYINITIAL; --- . /* skip */; --- [\n] ++yy_mylinenumber; -lexMultiComment :: Maybe String -> (String, String) -> String -> Doc -lexMultiComment ns (b,e) comment = vcat - [ "" <> cstring b <+> "BEGIN" <+> text comment <> ";" - <+> "// BNFC: block comment" <+> cstring b <+> cstring e <> ";" - , commentTag <> cstring e <+> "BEGIN YYINITIAL;" - , commentTag <> ". /* skip */;" - , commentTag <> "[\\n] ++" <> text (fromMaybe "" ns) <> "yy_mylinenumber;" - ] - where - commentTag = text $ "<" ++ comment ++ ">" - --- | Helper function that escapes characters in strings. -escapeChars :: String -> String -escapeChars [] = [] -escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs)) -escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs)) -escapeChars (x:xs) = x : (escapeChars xs) diff --git a/src/BNFC/Backend/CPP/PrettyPrinter.hs b/src/BNFC/Backend/CPP/PrettyPrinter.hs --- a/src/BNFC/Backend/CPP/PrettyPrinter.hs +++ b/src/BNFC/Backend/CPP/PrettyPrinter.hs @@ -23,10 +23,12 @@ import Prelude hiding ((<>)) -import Data.Char(toLower) +import Data.Bifunctor (second) +import Data.Char (toLower) +import Data.Maybe (isJust) import BNFC.CF -import BNFC.Utils ((+++), when) +import BNFC.Utils import BNFC.Backend.Common import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Common.StrUtils (renderCharOrString) @@ -89,13 +91,16 @@ " void render(const char *s);", " void indent(void);", " void backup(void);", + " void onEmptyLine(void);", + " void removeTrailingSpaces(void);", + " void removeTrailingWhitespace(void);", " public:", " PrintAbsyn(void);", " ~PrintAbsyn(void);", " char *print(Visitable *v);" ] hdef = nsDefine inPackage "PRINTER_HEADER" - content = concatMap prDataH groups + content = concatMap (prDataH useStl) groups classFooter = unlines $ [ " void visitInteger(Integer i);", @@ -189,14 +194,18 @@ ] --Prints all the required method names and their parameters. -prDataH :: (Cat, [Rule]) -> String -prDataH (cat, rules) = - if isList cat - then concat [" void visit", cl, "(", cl, " *p);\n"] - else abstract ++ concatMap prRuleH rules +prDataH :: Bool -> (Cat, [Rule]) -> String +prDataH useSTL (cat, rules) + | isList cat = unlines $ concat + [ [ concat [ " void visit", cl, "(", cl, " *p);" ] ] + , when useSTL + [ concat [ " void iter", cl, "(", itty, " i, ", itty, " j);" ] ] + ] + | otherwise = abstract ++ concatMap prRuleH rules where - cl = identCat (normCat cat) - abstract = case lookupRule (noPosition $ show cat) rules of + cl = identCat (normCat cat) + itty = concat [ cl, "::", "const_iterator" ] + abstract = case lookupRule (noPosition $ catToStr cat) rules of Just _ -> "" Nothing -> " void visit" ++ cl ++ "(" ++ cl ++ " *p); /* abstract class */\n" @@ -394,140 +403,151 @@ abstract ++ concatMap (prPrintRule inPackage) rules where cl = identCat (normCat cat) - abstract = case lookupRule (noPosition $ show cat) rules of + abstract = case lookupRule (noPosition $ catToStr cat) rules of Just _ -> "" Nothing -> "void PrintAbsyn::visit" ++ cl ++ "(" ++ cl +++ "*p) {} //abstract class\n\n" --- | Generate pretty printer visitor for a list category: --- --- >>> let c = Cat "C" ; lc = ListCat c --- >>> let rules = [npRule "[]" lc [] Parsable, npRule "(:)" lc [Left c, Right "-", Left lc] Parsable] --- >>> genPrintVisitorList (lc, rules) --- void PrintAbsyn::visitListC(ListC *listc) --- { --- for (ListC::const_iterator i = listc->begin() ; i != listc->end() ; ++i) --- { --- (*i)->accept(this); --- render('-'); --- } --- } +-- | Generate pretty printer visitor for a list category (STL version). -- --- >>> let c2 = CoercCat "C" 2 ; lc2 = ListCat c2 --- >>> let rules2 = rules ++ [npRule "[]" lc2 [] Parsable, npRule "(:)" lc2 [Left c2, Right "+", Left lc2] Parsable] --- >>> genPrintVisitorList (lc, rules2) --- void PrintAbsyn::visitListC(ListC *listc) --- { --- for (ListC::const_iterator i = listc->begin() ; i != listc->end() ; ++i) --- { --- (*i)->accept(this); --- switch(_i_) --- { --- case 2: render('+'); break; --- default: render('-'); --- } --- } --- } genPrintVisitorList :: (Cat, [Rule]) -> Doc -genPrintVisitorList (cat@(ListCat c), rules) = - "void PrintAbsyn::visit" <> text cl <> "(" <> text cl <> " *" <> vname <> ")" - $$ codeblock 2 - [ "for ("<> text cl <> "::const_iterator i = " <> vname <> "->begin() ; i != " <> vname <> "->end() ; ++i)" - , codeblock 2 - [ if isTokenCat c - then "visit" <> text (baseName cl) <> "(*i) ;" - else "(*i)->accept(this);" - , (if hasOneFunc rules - then "if (i != " <> vname <> "->end() - 1)" - else empty) - <+> renderListSepByPrecedence "_i_" renderSep separators - ] +genPrintVisitorList (cat@(ListCat c), rules) = vcat + [ "void PrintAbsyn::visit" <> lty <> parens (lty <+> "*" <> vname) + , codeblock 2 + [ "iter" <> lty <> parens (vname <> "->begin()" <> comma <+> vname <> "->end()") <> semi ] + , "" + , "void PrintAbsyn::iter" <> lty <> parens (itty <+> "i" <> comma <+> itty <+> "j") + , codeblock 2 $ concat + [ if null docs0 then + [ "if (i == j) return;" ] + else + [ "if (i == j)" + , "{ /* nil */" + , nest 2 $ vcat docs0 + , "}" + , "else" ] + , unless (null docs1) + [ "if (i == j-1)" + , "{ /* last */" + , nest 2 $ vcat docs1 + , "}" + , "else" + ] + , [ "{ /* cons */" + , nest 2 $ vcat docs2 + , "}" + ] + ] + , "" + , "" + ] where - separators = getSeparatorByPrecedence rules - cl = identCat (normCat cat) - vname = text $ map toLower cl - renderSep s = "render(" <> text (snd (renderCharOrString s)) <> ")" + cl = identCat (normCat cat) + lty = text cl -- List type + itty = lty <> "::const_iterator" -- Iterator type + vname = text $ map toLower cl + prules = sortRulesByPrecedence rules + swRules f = switchByPrecedence "_i_" $ + map (second $ sep . prListRule_) $ + uniqOn fst $ filter f prules + -- Discard duplicates, can only handle one rule per precedence. + docs0 = swRules isNilFun + docs1 = swRules isOneFun + docs2 = swRules isConsFun genPrintVisitorList _ = error "genPrintVisitorList expects a ListCat" --- | This is the only part of the pretty printer that differs significantly +-- | Only render the rhs (items) of a list rule. + +prListRule_ :: IsFun a => Rul a -> [Doc] +prListRule_ (Rule _ _ items _) = for items $ \case + Right t -> "render(" <> text (snd (renderCharOrString t)) <> ");" + Left c + | Just t <- maybeTokenCat c + -> "visit" <> dat <> "(*i);" + | isList c -> "iter" <> dat <> "(i+1, j);" + | otherwise -> "(*i)->accept(this);" + where + dat = text $ identCat $ normCat c + +-- This is the only part of the pretty printer that differs significantly -- between the versions with and without STL. +-- The present version has been adapted from CFtoCPrinter. genPrintVisitorListNoStl :: (Cat, [Rule]) -> String genPrintVisitorListNoStl (cat@(ListCat c), rules) = unlines $ concat [ [ "void PrintAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")" , "{" - , " while(" ++ vname +++ "!= 0)" - , " {" - , " if (" ++ vname ++ "->" ++ vname ++ "_ == 0)" - , " {" - , visitMember - ] - , optsep - , [ " " ++ vname +++ "= 0;" - , " }" - , " else" - , " {" - , visitMember - , render $ nest 6 $ renderListSepByPrecedence "_i_" renderSep separators - , " " ++ vname +++ "=" +++ vname ++ "->" ++ vname ++ "_;" - , " }" - , " }" - , "}" - , "" + , " if (" ++ vname +++ "== 0)" + , " { /* nil */" + ] + , unlessNull (swRules isNilFun) $ \ docs -> + [ render $ nest 4 $ vcat docs ] + , [ " }" ] + , unlessNull (swRules isOneFun) $ \ docs -> + [ " else if (" ++ pre ++ vname ++ "_ == 0)" + , " { /* last */" + , render $ nest 4 $ vcat docs + , " }" + ] + , unlessNull (swRules isConsFun) $ \ docs -> + [ " else" + , " { /* cons */" + , render $ nest 4 $ vcat docs + , " }" + ] + , [ "}" + , "" + ] ] - ] where - visitMember - | Just t <- maybeTokenCat c = - " visit" ++ t ++ "(" ++ vname ++ "->" ++ member ++ ");" - | otherwise = - " " ++ vname ++ "->" ++ member ++ "->accept(this);" - cl = identCat (normCat cat) - ecl = identCat (normCatOfList cat) - vname = map toLower cl - member = map toLower ecl ++ "_" - optsep = if hasOneFunc rules || null sep' then [] - else [ " render(" ++ sep' ++ ");" ] - sep' = snd $ renderCharOrString $ getCons rules - renderSep s = "render(" <> text (snd $ renderCharOrString s) <> ")" - separators = getSeparatorByPrecedence rules + cl = identCat (normCat cat) + vname = map toLower cl + pre = vname ++ "->" + prules = sortRulesByPrecedence rules + swRules f = switchByPrecedence "_i_" $ + map (second $ sep . map text . prPrintRule_ pre) $ + uniqOn fst $ filter f prules + -- Discard duplicates, can only handle one rule per precedence. genPrintVisitorListNoStl _ = error "genPrintVisitorListNoStl expects a ListCat" --Pretty Printer methods for a rule. prPrintRule :: Maybe String -> Rule -> String -prPrintRule inPackage r@(Rule fun _ cats _) | isProperLabel fun = unlines - [ - "void PrintAbsyn::visit" ++ funName fun ++ "(" ++ funName fun +++ "*" ++ fnm ++ ")", - "{", - " int oldi = _i_;", - lparen, - cats', - rparen, - " _i_ = oldi;", - "}", - "" +prPrintRule inPackage r@(Rule fun _ items _) | isProperLabel fun = unlines $ concat + [ [ "void PrintAbsyn::visit" ++ funName fun ++ "(" ++ funName fun +++ "*" ++ fnm ++ ")" + , "{" + , " int oldi = _i_;" + , parenCode "_L_PAREN" + , "" + ] + , prPrintRule_ (fnm ++ "->") r + , [ "" + , parenCode "_R_PAREN" + , " _i_ = oldi;" + , "}" + , "" + ] ] - where - p = precRule r - (lparen, rparen) = - (" if (oldi > " ++ show p ++ ") render(" ++ nsDefine inPackage "_L_PAREN" ++ ");\n", - " if (oldi > " ++ show p ++ ") render(" ++ nsDefine inPackage "_R_PAREN" ++ ");\n") - cats' = concatMap (prPrintCat fnm) (numVars cats) - fnm = "p" --old names could cause conflicts + where + p = precRule r + parenCode x = " if (oldi > " ++ show p ++ ") render(" ++ nsDefine inPackage x ++ ");" + fnm = "p" --old names could cause conflicts prPrintRule _ _ = "" +prPrintRule_ :: IsFun a => String -> Rul a -> [String] +prPrintRule_ pre (Rule _ _ items _) = map (prPrintItem pre) $ numVars items + --This goes on to recurse to the instance variables. -prPrintCat :: String -> Either (Cat, Doc) String -> String -prPrintCat _ (Right t) = " render(" ++ t' ++ ");\n" - where t' = snd (renderCharOrString t) -prPrintCat fnm (Left (c, nt)) +prPrintItem :: String -> Either (Cat, Doc) String -> String +prPrintItem _ (Right t) = " render(" ++ snd (renderCharOrString t) ++ ");" +prPrintItem pre (Left (c, nt)) | Just t <- maybeTokenCat c - = " visit" ++ t ++ "(" ++ fnm ++ "->" ++ s ++ ");\n" - | isList c = " if(" ++ fnm ++ "->" ++ s ++ ") {" ++ accept ++ "}\n" - | otherwise = " " ++ accept ++ "\n" + = " visit" ++ t ++ "(" ++ pre ++ s ++ ");" + | isList c = " " ++ setI (precCat c) ++ + "visit" ++ elt ++ "(" ++ pre ++ s ++ ");" + | otherwise = " " ++ setI (precCat c) ++ pre ++ s ++ "->accept(this);" where - s = render nt - accept = setI (precCat c) ++ fnm ++ "->" ++ s ++ "->accept(this);" + s = render nt + elt = identCat $ normCat c {- **** Abstract Syntax Tree Printer **** -} @@ -587,7 +607,7 @@ abstract ++ concatMap prShowRule rules where cl = identCat (normCat cat) - abstract = case lookupRule (noPosition $ show cat) rules of + abstract = case lookupRule (noPosition $ catToStr cat) rules of Just _ -> "" Nothing -> "void ShowAbsyn::visit" ++ cl ++ "(" ++ cl ++ " *p) {} //abstract class\n\n" @@ -660,8 +680,7 @@ "{", " if (c == '{')", " {", - " bufAppend('\\n');", - " indent();", + " onEmptyLine();", " bufAppend(c);", " _n_ = _n_ + INDENT_WIDTH;", " bufAppend('\\n');", @@ -671,30 +690,27 @@ " bufAppend(c);", " else if (c == ')' || c == ']')", " {", - " backup();", + " removeTrailingWhitespace();", " bufAppend(c);", " bufAppend(' ');", " }", " else if (c == '}')", " {", - " int t;", " _n_ = _n_ - INDENT_WIDTH;", - " for (t=0; t String printParseErrHeader inPackage = @@ -149,6 +157,7 @@ " " ++ scope ++ "PrintAbsyn *p = new " ++ scope ++ "PrintAbsyn();", " printf(\"%s\\n\\n\", p->print(parse_tree));", " }", + " delete(parse_tree);", " return 0;", " }", " return 1;", @@ -167,50 +176,18 @@ , "" , "#include" , "#include" + , "#include \"Absyn.H\"" , "" , nsStart inPackage ] - , map mkForwardDec $ List.nub $ map normCat cats - , [ "typedef union" - , "{" - ] - , map (" " ++) unionBuiltinTokens - , concatMap mkVar cats - , [ "} YYSTYPE;" - , "" - ] , concatMap mkFuncs eps , [ nsEnd inPackage , "" - , "#define " ++ nsDefine inPackage "_ERROR_" ++ " 258" - , mkDefines (259 :: Int) env - , "extern " ++ nsScope inPackage ++ "YYSTYPE " ++ nsString inPackage ++ "yylval;" - , "" , "#endif" ] ] where hdef = nsDefine inPackage "PARSER_HEADER_FILE" - mkForwardDec s = "class " ++ identCat s ++ ";" - mkVar s | normCat s == s = [ " " ++ identCat s ++"*" +++ map toLower (identCat s) ++ "_;" ] - mkVar _ = [] - mkDefines n [] = mkString n - mkDefines n (s:ss) = "#define " ++ s +++ show n ++ "\n" ++ mkDefines (n+1) ss -- "nsDefine inPackage s" not needed (see cf2flex::makeSymEnv) - mkString n = if isUsedCat cf (TokenCat catString) - then ("#define " ++ nsDefine inPackage "_STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) - else mkChar n - mkChar n = if isUsedCat cf (TokenCat catChar) - then ("#define " ++ nsDefine inPackage "_CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) - else mkInteger n - mkInteger n = if isUsedCat cf (TokenCat catInteger) - then ("#define " ++ nsDefine inPackage "_INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) - else mkDouble n - mkDouble n = if isUsedCat cf (TokenCat catDouble) - then ("#define " ++ nsDefine inPackage "_DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) - else mkIdent n - mkIdent n = if isUsedCat cf (TokenCat catIdent) - then "#define " ++ nsDefine inPackage "_IDENT_ " ++ show n ++ "\n" - else "" mkFuncs s = [ identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);" , identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(const char *str);" diff --git a/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs b/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs deleted file mode 100644 --- a/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs +++ /dev/null @@ -1,378 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} - -{- - BNF Converter: C++ Bison generator - Copyright (C) 2004 Author: Michael Pellauer - - Description : This module generates the Bison input file using - STL. The main difference to CFtoBison is in handling - lists: by using std::vector and push_back, our rules - for reverting lists are the opposite to linked lists. - Note that because of the way bison stores results - the programmer can increase performance by limiting - the number of entry points in their grammar. - - Author : Michael Pellauer - Created : 6 August, 2003 - Modified : 19 August, 2006, by Aarne Ranta (aarne@cs.chalmers.se) - --} - -module BNFC.Backend.CPP.STL.CFtoBisonSTL - ( cf2Bison - , tokens, union - , definedRules - ) where - -import Prelude hiding ((<>)) - -import Data.Char ( isUpper ) -import Data.Foldable (toList) -import Data.List ( nub, intercalate ) -import Data.Maybe ( fromMaybe ) -import qualified Data.Map as Map - -import BNFC.Backend.C.CFtoBisonC - ( resultName, specialToks, startSymbol, typeName, unionBuiltinTokens, varName ) -import BNFC.Backend.CPP.STL.STLUtils -import BNFC.Backend.Common.NamedVariables hiding (varName) -import BNFC.CF -import BNFC.Options (RecordPositions(..)) -import BNFC.PrettyPrint -import BNFC.TypeChecker -import BNFC.Utils ((+++), when) - ---This follows the basic structure of CFtoHappy. - --- Type declarations -type Rules = [(NonTerminal,[(Pattern,Action)])] -type Pattern = String -type Action = String -type MetaVar = String - ---The environment comes from the CFtoFlex -cf2Bison :: RecordPositions -> Maybe String -> String -> CF -> SymMap -> String -cf2Bison rp inPackage name cf env - = unlines - [header inPackage name cf, - render $ union inPackage (map TokenCat (positionCats cf) ++ allParserCats cf), - maybe "" (\ns -> "%define api.prefix {" ++ ns ++ "yy}") inPackage, - "%token _ERROR_", - tokens user env, - declarations cf, - startSymbol cf, - specialToks cf, - "%%", - prRules (rulesForBison rp inPackage cf env) - ] - where - user = fst (unzip (tokenPragmas cf)) - - -positionCats cf = filter (isPositionCat cf) $ fst (unzip (tokenPragmas cf)) - -header :: Maybe String -> String -> CF -> String -header inPackage name cf = unlines - [ "/* This Bison file was machine-generated by BNFC */" - , "%{" - , "#include " - , "#include " - , "#include " - , "#include " - , "#include \"ParserError.H\"" - , "#include \"Absyn.H\"" - , "" - , "#define YYMAXDEPTH 10000000" -- default maximum stack size is 10000, but right-recursion needs O(n) stack - , "" - , "typedef struct yy_buffer_state *YY_BUFFER_STATE;" - , "int yyparse(void);" - , "int yylex(void);" - , "YY_BUFFER_STATE " ++ ns ++ "yy_scan_string(const char *str);" - , "void " ++ ns ++ "yy_delete_buffer(YY_BUFFER_STATE buf);" - , "int " ++ ns ++ "yy_mylinenumber;" --- hack to get line number. AR 2006 - , "void " ++ ns ++ "initialize_lexer(FILE * inp);" - , "int " ++ ns ++ "yywrap(void)" - , "{" - , " return 1;" - , "}" - , "void " ++ ns ++ "yyerror(const char *str)" - , "{" - , " throw "++ns++"::parse_error("++ ns ++ "yy_mylinenumber,str);" - , "}" - , "" - , nsStart inPackage - , definedRules cf - , unlines $ map parseResult dats - , unlines $ map (parseMethod cf inPackage name) eps - , nsEnd inPackage - , "%}" - ] - where - ns = nsString inPackage - eps = toList (allEntryPoints cf) ++ map TokenCat (positionCats cf) - dats = nub $ map normCat eps - -definedRules :: CF -> String -definedRules cf = - unlines [ rule f xs e | FunDef f xs e <- cfgPragmas cf ] - where - ctx = buildContext cf - - list = LC (const "[]") (\ t -> "List" ++ unBase t) - where - unBase (ListT t) = unBase t - unBase (BaseT x) = show $ normCat $ strToCat x - - rule f xs e = - case runTypeChecker $ checkDefinition' list ctx f xs e of - Left err -> error $ "Panic! This should have been caught already:\n" ++ err - Right (args,(e',t)) -> unlines - [ cppType t ++ " " ++ funName f ++ "_ (" ++ - intercalate ", " (map cppArg args) ++ ") {" - , " return " ++ cppExp e' ++ ";" - , "}" - ] - where - cppType :: Base -> String - cppType (ListT (BaseT x)) = "List" ++ show (normCat $ strToCat x) ++ " *" - cppType (ListT t) = cppType t ++ " *" - cppType (BaseT x) - | x `elem` baseTokenCatNames = x - | isToken x ctx = "String" - | otherwise = show (normCat $ strToCat x) ++ " *" - - cppArg :: (String, Base) -> String - cppArg (x,t) = cppType t ++ " " ++ x ++ "_" - - cppExp :: Exp -> String - cppExp (App "[]" []) = "0" - cppExp (Var x) = x ++ "_" -- argument - cppExp (App t [e]) - | isToken t ctx = cppExp e - cppExp (App x es) - | isUpper (head x) = call ("new " ++ x) es - | otherwise = call (x ++ "_") es - cppExp (LitInt n) = show n - cppExp (LitDouble x) = show x - cppExp (LitChar c) = show c - cppExp (LitString s) = show s - - call x es = x ++ "(" ++ intercalate ", " (map cppExp es) ++ ")" - - --- | Generates declaration and initialization of the @YY_RESULT@ for a parser. --- --- Different parsers (for different precedences of the same category) --- share such a declaration. --- --- Expects a normalized category. -parseResult :: Cat -> String -parseResult cat = - "static " ++ cat' ++ "*" +++ resultName cat' +++ "= 0;" - where - cat' = identCat cat - ---This generates a parser method for each entry point. -parseMethod :: CF -> Maybe String -> String -> Cat -> String -parseMethod cf inPackage _ cat = unlines $ concat - [ [ cat' ++ "* p" ++ par ++ "(FILE *inp)" - , "{" - , " " ++ ns ++ "yy_mylinenumber = 1;" - , " " ++ ns ++ "initialize_lexer(inp);" - , " if (yyparse())" - , " { /* Failure */" - , " return 0;" - , " }" - , " else" - , " { /* Success */" - ] - , revOpt - , [ " return" +++ res ++ ";" - , " }" - , "}" - , cat' ++ "* p" ++ par ++ "(const char *str)" - , "{" - , " YY_BUFFER_STATE buf;" - , " int result;" - , " " ++ ns ++ "yy_mylinenumber = 1;" - , " " ++ ns ++ "initialize_lexer(0);" - , " buf = " ++ ns ++ "yy_scan_string(str);" - , " result = yyparse();" - , " " ++ ns ++ "yy_delete_buffer(buf);" - , " if (result)" - , " { /* Failure */" - , " return 0;" - , " }" - , " else" - , " { /* Success */" - ] - , revOpt - , [ " return" +++ res ++ ";" - , " }" - , "}" - ] - ] - where - cat' = identCat (normCat cat) - par = identCat cat - ns = nsString inPackage - res = resultName cat' - -- Vectors are snoc lists - revOpt = when (isList cat && cat `notElem` cfgReversibleCats cf) - [ "std::reverse(" ++ res ++ "->begin(), " ++ res ++"->end());" ] - --- | The union declaration is special to Bison/Yacc and gives the type of --- yylval. For efficiency, we may want to only include used categories here. --- --- >>> let foo = Cat "Foo" --- >>> union Nothing [foo, ListCat foo] --- %union --- { --- int _int; --- char _char; --- double _double; --- char* _string; --- Foo* foo_; --- ListFoo* listfoo_; --- } --- --- If the given list of categories is contains coerced categories, those should --- be normalized and duplicate removed --- E.g. if there is both [Foo] and [Foo2] we should only print one pointer: --- ListFoo* listfoo_; --- --- >>> let foo2 = CoercCat "Foo" 2 --- >>> union Nothing [foo, ListCat foo, foo2, ListCat foo2] --- %union --- { --- int _int; --- char _char; --- double _double; --- char* _string; --- Foo* foo_; --- ListFoo* listfoo_; --- } -union :: Maybe String -> [Cat] -> Doc -union inPackage cats = vcat - [ "%union" - , codeblock 2 $ map text unionBuiltinTokens ++ map mkPointer normCats - ] - where - normCats = nub (map normCat cats) - mkPointer s = scope <> text (identCat s) <> "*" <+> text (varName s) <> ";" - scope = text (nsScope inPackage) - ---declares non-terminal types. -declarations :: CF -> String -declarations cf = concatMap typeNT $ - map TokenCat (positionCats cf) ++ - filter (not . null . rulesForCat cf) (allParserCats cf) -- don't define internal rules - where - typeNT nt = "%type <" ++ varName nt ++ "> " ++ identCat nt ++ "\n" - ---declares terminal types. -tokens :: [UserDef] -> SymMap -> String -tokens user env = unlines $ map declTok $ Map.toList env - where - declTok (Keyword s, r) = tok "" s r - declTok (Tokentype s, r) = tok (if s `elem` user then "<_string>" else "") s r - tok t s r = concat [ "%token", t, " ", r, " // ", s ] - ---The following functions are a (relatively) straightforward translation ---of the ones in CFtoHappy.hs - -rulesForBison :: RecordPositions -> Maybe String -> CF -> SymMap -> Rules -rulesForBison rp inPackage cf env = map mkOne (ruleGroups cf) ++ posRules - where - mkOne (cat,rules) = constructRule rp inPackage cf env rules cat - posRules = (`map` positionCats cf) $ \ n -> (TokenCat n, - [( fromMaybe n $ Map.lookup (Tokentype n) env - , concat - [ "$$ = new ", nsScope inPackage, n, "($1, ", nsString inPackage, "yy_mylinenumber); " - , nsScope inPackage, "YY_RESULT_", n, "_= $$;" - ] - )]) - --- For every non-terminal, we construct a set of rules. -constructRule :: - RecordPositions -> Maybe String -> CF -> SymMap -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) -constructRule rp inPackage cf env rules nt = - (nt,[(p, generateAction rp inPackage nt (funName $ ruleName r) b m +++ result) | - r0 <- rules, - let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs - then (True,revSepListRule r0) - else (False,r0), - let (p,m) = generatePatterns cf env r b]) - where - ruleName r = case funRule r of - ---- "(:)" -> identCat nt - ---- "(:[])" -> identCat nt - z -> z - revs = cfgReversibleCats cf - eps = toList $ allEntryPoints cf - isEntry nt = nt `elem` eps - result = if isEntry nt then (nsScope inPackage ++ resultName (identCat (normCat nt))) ++ "= $$;" else "" - --- Generates a string containing the semantic action. -generateAction :: RecordPositions -> Maybe String -> NonTerminal -> Fun -> Bool -> [(MetaVar,Bool)] -> Action -generateAction rp inPackage cat f b mbs = - reverses ++ - if isCoercion f - then "$$ = " ++ unwords ms ++ ";" - else if f == "[]" - then concat ["$$ = ","new ", scope, identCatV cat, "();"] - else if f == "(:[])" - then concat ["$$ = ","new ", scope, identCatV cat, "() ; $$->push_back($1);"] - else if f == "(:)" && b - then "$1->push_back("++ lastms ++ ") ; $$ = $1 ;" - else if f == "(:)" - then lastms ++ "->push_back(" ++ head ms ++ ") ; $$ = " ++ lastms ++ " ;" ---- not left rec - else if isDefinedRule f - then concat ["$$ = ", scope, f, "_", "(", intercalate ", " ms, ");" ] - else concat - ["$$ = ", "new ", scope, f, "(", intercalate ", " ms, ");" ++ addLn rp] - where - ms = map fst mbs - lastms = last ms - addLn rp = if rp == RecordPositions then " $$->line_number = " ++ nsString inPackage ++ "yy_mylinenumber;" else "" -- O.F. - identCatV = identCat . normCat - reverses = unwords [ - "std::reverse(" ++ m ++"->begin(),"++m++"->end()) ;" | - (m,True) <- mbs] - scope = nsScope inPackage - --- Generate patterns and a set of metavariables indicating --- where in the pattern the non-terminal -generatePatterns :: CF -> SymMap -> Rule -> Bool -> (Pattern,[(MetaVar,Bool)]) -generatePatterns cf env r _ = case rhsRule r of - [] -> ("/* empty */",[]) - its -> (unwords (map mkIt its), metas its) - where - mkIt = \case - Left (TokenCat s) - | isPositionCat cf s -> typeName s - | otherwise -> fromMaybe (typeName s) $ Map.lookup (Tokentype s) env - Left c -> identCat c - Right s -> fromMaybe s $ Map.lookup (Keyword s) env - metas its = [('$': show i,revert c) | (i,Left c) <- zip [1 :: Int ..] its] - - -- notice: reversibility with push_back vectors is the opposite - -- of right-recursive lists! - revert c = isList c && not (isConsFun (funRule r)) && notElem c revs - revs = cfgReversibleCats cf - --- We have now constructed the patterns and actions, --- so the only thing left is to merge them into one string. - -prRules :: Rules -> String -prRules [] = [] -prRules ((_, []):rs) = prRules rs --internal rule -prRules ((nt, (p, a) : ls):rs) = - unwords [nt', ":" , p, "{ ", a, "}", "\n" ++ pr ls] ++ ";\n" ++ prRules rs - where - nt' = identCat nt - pr [] = [] - pr ((p,a):ls) = unlines [unwords [" |", p, "{ ", a , "}"]] ++ pr ls diff --git a/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs b/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs --- a/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs +++ b/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TupleSections #-} + {- BNF Converter: C++ abstract syntax generator Copyright (C) 2004 Author: Michael Pellauer @@ -16,17 +18,21 @@ module BNFC.Backend.CPP.STL.CFtoSTLAbs (cf2CPPAbs) where +import Data.List ( intercalate, intersperse ) + import BNFC.Backend.Common.OOAbstract import BNFC.CF -import BNFC.Options (RecordPositions(..)) -import BNFC.Utils((+++)) -import Data.List +import BNFC.Options ( RecordPositions(..) ) +import BNFC.TypeChecker ( ListConstructors(..) ) +import BNFC.Utils ( (+++), applyWhen ) + +import BNFC.Backend.CPP.Common import BNFC.Backend.CPP.STL.STLUtils --The result is two files (.H file, .C file) cf2CPPAbs :: RecordPositions -> Maybe String -> String -> CF -> (String, String) -cf2CPPAbs rp inPackage _ cf = (mkHFile rp inPackage cab, mkCFile inPackage cab) +cf2CPPAbs rp inPackage _ cf = (mkHFile rp inPackage cab cf, mkCFile inPackage cab cf) where cab = cf2cabs cf @@ -34,8 +40,8 @@ -- **** Header (.H) File Functions **** -- --Makes the Header file. -mkHFile :: RecordPositions -> Maybe String -> CAbs -> String -mkHFile rp inPackage cf = unlines +mkHFile :: RecordPositions -> Maybe String -> CAbs -> CF -> String +mkHFile rp inPackage cabs cf = unlines [ "#ifndef " ++ hdef, "#define " ++ hdef, @@ -49,29 +55,32 @@ "", unlines ["typedef " ++ d ++ " " ++ c ++ ";" | (c,d) <- basetypes], "", - unlines ["typedef std::string " ++ s ++ ";" | s <- tokentypes cf], + unlines ["typedef std::string " ++ s ++ ";" | s <- tokentypes cabs], "", "/******************** Forward Declarations ********************/", "", - unlines ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cf)], + unlines ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cabs)], "", "/******************** Visitor Interfaces ********************/", - prVisitor cf, + prVisitor cabs, "", prVisitable, "", "/******************** Abstract Syntax Classes ********************/", "", - unlines [prAbs rp c | c <- absclasses cf], + unlines [prAbs rp c | c <- absclasses cabs], "", - unlines [prCon (c,r) | (c,rs) <- signatures cf, r <- rs], + unlines [prCon (c,r) | (c,rs) <- signatures cabs, r <- rs], "", - unlines [prList c | c <- listtypes cf], + unlines [prList c | c <- listtypes cabs], + "", + definedRules Nothing cf + "/******************** Defined Constructors ********************/", nsEnd inPackage, "#endif" ] where - classes = allClasses cf + classes = allClasses cabs hdef = nsDefine inPackage "ABSYN_HEADER" -- auxiliaries @@ -133,34 +142,43 @@ conargs = concat $ intersperse ", " [x +++ pointerIf st ("p" ++ show i) | ((x,st,_),i) <- zip cs [1..]] -prList :: (String,Bool) -> String -prList (c,b) = unlines [ - "class " ++c++ " : public Visitable, public std::vector<" ++bas++ ">", - "{", - "public:", - " virtual void accept(Visitor *v);", - " virtual " ++ c ++ " *clone() const;", - "};" +prList :: (String, Bool) -> String +prList (c, b) = unlines + [ "class " ++c++ " : public Visitable, public std::vector<" ++bas++ ">" + , "{" + , "public:" + , " virtual void accept(Visitor *v);" + , " virtual " ++ c ++ " *clone() const;" + , "};" + , "" + -- cons for this list type + , concat [ c, "* ", "cons", c, "(", bas, " x, ", c, "* xs);" ] ] - where - bas = drop 4 c {- drop "List" -} ++ if b then "*" else "" + where + bas = applyWhen b (++ "*") $ drop 4 c {- drop "List" -} -- **** Implementation (.C) File Functions **** -- -mkCFile :: Maybe String -> CAbs -> String -mkCFile inPackage cf = unlines $ [ +mkCFile :: Maybe String -> CAbs -> CF -> String +mkCFile inPackage cabs cf = unlines $ [ "//C++ Abstract Syntax Implementation generated by the BNF Converter.", "#include ", "#include ", "#include ", "#include \"Absyn.H\"", nsStart inPackage, - unlines [prConC r | (_,rs) <- signatures cf, r <- rs], - unlines [prListC c | (c,_) <- listtypes cf], + unlines [prConC r | (_,rs) <- signatures cabs, r <- rs], + unlines [prListC l | l <- listtypes cabs], + definedRules (Just $ LC nil cons) cf + "/******************** Defined Constructors ********************/", nsEnd inPackage ] + where + nil t = (,dummyType) $ concat [ "new List", identType t, "()" ] + cons t = (,dummyType) $ concat [ "consList", identType t ] + prConC :: CAbsRule -> String prConC fcs@(f,_) = unlines [ "/******************** " ++ f ++ " ********************/", @@ -172,14 +190,14 @@ "" ] -prListC :: String -> String -prListC c = unlines [ - "/******************** " ++ c ++ " ********************/", - "", - prAcceptC c, - "", - prCloneC c - ] +prListC :: (String,Bool) -> String +prListC (c,b) = unlines + [ "/******************** " ++ c ++ " ********************/" + , "" + , prAcceptC c + , prCloneC c + , prConsC c b + ] --The standard accept function for the Visitor pattern @@ -199,6 +217,17 @@ " return new" +++ c ++ "(*this);", "}" ] + +-- | Make a list constructor definition. +prConsC :: String -> Bool -> String +prConsC c b = unlines + [ concat [ c, "* ", "cons", c, "(", bas, " x, ", c, "* xs) {" ] + , " xs->insert(xs->begin(), x);" + , " return xs;" + , "}" + ] + where + bas = applyWhen b (++ "*") $ drop 4 c {- drop "List" -} --The constructor assigns the parameters to the corresponding instance variables. prConstructorC :: CAbsRule -> String diff --git a/src/BNFC/Backend/Common.hs b/src/BNFC/Backend/Common.hs --- a/src/BNFC/Backend/Common.hs +++ b/src/BNFC/Backend/Common.hs @@ -1,14 +1,23 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- | Functions common to different backends. -module BNFC.Backend.Common where +module BNFC.Backend.Common + ( unicodeAndSymbols + , asciiKeywords + , flexEps + , switchByPrecedence + ) + where import Prelude hiding ((<>)) +import Data.Bifunctor ( second ) import Data.Char import BNFC.CF +import BNFC.Utils ( (>.>) ) import BNFC.PrettyPrint -- Andreas, 2020-10-08, issue #292: @@ -40,16 +49,35 @@ -- switch(x) -- { -- case 3: my_render(";"); break; --- default: my_render("--"); +-- case 1: my_render("--"); break; -- } -renderListSepByPrecedence :: Doc -- ^ Name of the coercion level variable - -> (String -> Doc) -- ^ render function - -> [(Integer, String)] -- ^ separators by precedence - -> Doc -renderListSepByPrecedence _ _ [] = empty -renderListSepByPrecedence _ render [(_,sep)] = render sep <> ";" -renderListSepByPrecedence var render ss = "switch(" <> var <> ")" $$ codeblock 2 - ( ["case" <+> integer i <:> render sep <>"; break;" | (i, sep) <- init ss] - ++ ["default" <:> render sep <>";" | let (_,sep) = last ss]) - where +renderListSepByPrecedence + :: Doc -- ^ Name of the coercion level variable + -> (String -> Doc) -- ^ render function + -> [(Integer, String)] -- ^ separators by precedence + -> Doc +renderListSepByPrecedence var render = + vcat . switchByPrecedence var . map (second $ render >.> (<> ";")) + +-- Note (Andreas, 2021-05-02): +-- @renderListSepByPrecedence@ did not account for mixfix lists (issue #358) +-- and has been replaced by the more general @switchByPrecedence@. + +switchByPrecedence + :: Doc -- ^ Name of the coercion level variable/ + -> [(Integer, Doc)] -- ^ Content by precedence. + -> [Doc] +switchByPrecedence var = filter (not . isEmpty . snd) >.> \case + [] -> [] + [(_,doc)] -> [ doc ] + ds -> + [ "switch(" <> var <> ")" + , codeblock 2 + [ "case" <+> integer i <:> doc <+> "break;" | (i, doc) <- ds ] + -- , codeblock 2 $ concat + -- [ [ "case" <+> integer i <:> doc <+> "break;" | (i, doc) <- init ds ] + -- , [ "default" <:> doc | let (i, doc) = last ds ] + -- ] + ] + where a <:> b = a <> ":" <+> b diff --git a/src/BNFC/Backend/Common/NamedVariables.hs b/src/BNFC/Backend/Common/NamedVariables.hs --- a/src/BNFC/Backend/Common/NamedVariables.hs +++ b/src/BNFC/Backend/Common/NamedVariables.hs @@ -132,15 +132,16 @@ --This fixes the problem with coercions. fixCoercions :: [(Cat, [Rule])] -> [(Cat, [Rule])] fixCoercions rs = nub (fixAll rs rs) - where + where fixCoercion :: Cat -> [(Cat, [Rule])] -> [Rule] fixCoercion _ [] = [] fixCoercion cat ((c,rules):cats) = if normCat c == normCat cat then rules ++ fixCoercion cat cats else fixCoercion cat cats + fixAll :: [(Cat, [Rule])] -> [(Cat, [Rule])] -> [(Cat, [Rule])] fixAll _ [] = [] - fixAll top ((cat,_):cats) = if isCoercion (noPosition $ show cat) -- This is weird: isCoercion is supposed to be applied to functions!!!! + fixAll top ((cat,_):cats) = if isCoercion (noPosition $ catToStr cat) -- This is weird: isCoercion is supposed to be applied to functions!!!! then fixAll top cats else (normCat cat, fixCoercion cat top) : fixAll top cats @@ -148,7 +149,7 @@ varName c = map toLower c ++ "_" --this makes var names a little cleaner. -showNum n = if n == 0 then [] else show n +showNum n = if n == 0 then "" else show n -- Makes the first letter a lowercase. firstLowerCase :: String -> String diff --git a/src/BNFC/Backend/Common/OOAbstract.hs b/src/BNFC/Backend/Common/OOAbstract.hs --- a/src/BNFC/Backend/Common/OOAbstract.hs +++ b/src/BNFC/Backend/Common/OOAbstract.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} + {- BNF Converter: Datastructure for object-oriented abstract syntax generators Copyright (C) 2006 Author: Aarne Ranta @@ -15,9 +17,11 @@ module BNFC.Backend.Common.OOAbstract where +import Data.Char (toLower) +import qualified Data.List as List +import Data.Maybe + import BNFC.CF -import Data.List -import Data.Char(toLower) -- A datastructure more appropriate than CF @@ -45,19 +49,19 @@ map fst basetypes ++ tokentypes ca cf2cabs :: CF -> CAbs -cf2cabs cf = CAbs { - tokentypes = toks, - listtypes = [(c, snd (status (drop 4 c))) | -- remove "List" from "ListC" - c <- map (identCat . normCat) lists], - absclasses = nub $ map (show.normCat) cats, - conclasses = [f | Just f <- map testRule (cfgRules cf)], - signatures = posdata ++ map normSig (cf2data cf), - postokens = pos, - defineds = defs +cf2cabs cf = CAbs + { tokentypes = toks + , listtypes = [(c, snd (status (drop 4 c))) | -- remove "List" from "ListC" + c <- map (identCat . normCat) lists] + , absclasses = List.nub $ map (identCat . normCat) cats -- NB: does not include list categories + , conclasses = mapMaybe testRule $ cfgRules cf + , signatures = posdata ++ map normSig (cf2data cf) + , postokens = pos + , defineds = defs } where - (pos, toks) = partition (isPositionCat cf) $ map fst $ tokenPragmas cf - (lists,cats) = partition isList $ allCatsNorm cf + (pos, toks) = List.partition (isPositionCat cf) $ map fst $ tokenPragmas cf + (lists,cats) = List.partition isList $ allCatsNorm cf testRule (Rule f c _ _) | isList (wpThing c) = Nothing | funName f == "_" = Nothing @@ -68,15 +72,15 @@ [("Visitable", -- to give superclass [(c,[("String",False,"string_"),("Integer",False,"integer_")])]) | c<-pos] status cat = (cat, notElem cat (map fst basetypes ++ toks)) - defs = [ funName f | FunDef f _ _ <- cfgPragmas cf] + defs = [ funName f | FunDef (Define f _ _ _) <- cfgPragmas cf] classVars :: [(String,Bool)] -> [(String,Bool,String)] classVars cs = [(c,b,s) | ((c,b),s) <- zip cs (vars [] (map (classVar . fst) cs))] --- creating new names is quadratic, but parameter lists are short --- this should conform with Michael's naming - vars seen vv = case vv of - [] -> vv + vars seen = \case + [] -> [] v:vs -> case length (filter (==v) seen) of 0 | elem v vs -> (v ++ "1"): vars (v:seen) vs 0 -> v : vars (v:seen) vs diff --git a/src/BNFC/Backend/Haskell.hs b/src/BNFC/Backend/Haskell.hs --- a/src/BNFC/Backend/Haskell.hs +++ b/src/BNFC/Backend/Haskell.hs @@ -9,6 +9,7 @@ module BNFC.Backend.Haskell (makeHaskell, AlexVersion(..), makefile, testfile) where import qualified Control.Monad as Ctrl +import Data.Maybe (isJust) import System.FilePath ((<.>), (), pathSeparator) import Text.Printf (printf) import Text.PrettyPrint @@ -58,7 +59,7 @@ liftIO $ printf "Use Alex 3 to compile %s.\n" (alexFile opts) Ctrl.when (hasLayout cf) $ mkfile (layoutFile opts) $ - cf2Layout (tokenText opts) layMod lexMod cf + cf2Layout layMod lexMod cf -- Generate Happy parser and matching test program. do @@ -84,7 +85,7 @@ Ctrl.when (agda opts) $ makeAgda time opts cf -- Generate Makefile. - Makefile.mkMakefile opts $ makefile opts + Makefile.mkMakefile opts $ makefile opts cf -- | Generate the makefile (old version, with just one "all" target). @@ -186,9 +187,10 @@ -- | Generate the makefile. makefile :: Options + -> CF -> String -- ^ Filename of the makefile. -> Doc -- ^ Content of the makefile. -makefile opts makeFile = vcat +makefile opts cf makeFile = vcat [ makefileHeader opts , phonyRule , defaultRule @@ -234,11 +236,16 @@ where recipe = unwords [ "bnfc", printOptions opts{ make = Nothing } ] tgts = unwords . map ($ opts) . concat $ - [ [ absFile, alexFile, happyFile, printerFile, tFile ] + [ [ absFile ] + , [ layoutFile | lay ] + , [ alexFile, happyFile, printerFile, tFile ] , when (agda opts) [ agdaASTFile, agdaParserFile, agdaLibFile, agdaMainFile ] ] + lay :: Bool + lay = hasLayout cf + -- | Rule to invoke @happy@. happyRule :: Doc happyRule = Makefile.mkRule "%.hs" [ "%.y" ] [ "${HAPPY} ${HAPPY_OPTS} $<" ] @@ -254,28 +261,33 @@ tgt :: String tgt = tFileExe opts deps :: [String] - deps = map ($ opts) - [ absFile - , alexFileHs - , happyFileHs - , printerFile - , tFile + deps = map ($ opts) $ concat + [ [ absFile ] + , [ layoutFile | lay ] + , [ alexFileHs + , happyFileHs + , printerFile + , tFile + ] ] -- | Rule to build Agda parser. agdaRule :: Doc agdaRule = Makefile.mkRule "Main" deps [ "agda --no-libraries --ghc --ghc-flag=-Wwarn $<" ] where - deps = map ($ opts) - [ agdaMainFile -- must be first! - , agdaASTFile - , agdaParserFile - , agdaLibFile - -- Haskell modules bound by Agda modules: - , errFile - , alexFileHs - , happyFileHs - , printerFile + deps = map ($ opts) $ concat + [ [ agdaMainFile -- must be first! + , agdaASTFile + , agdaParserFile + , agdaLibFile + -- Haskell modules bound by Agda modules: + , errFile + ] + , [ layoutFile | lay ] + , [ alexFileHs + , happyFileHs + , printerFile + ] ] testfile :: Options -> CF -> String @@ -285,18 +297,18 @@ , "module Main where" , "" , "import Prelude" - , " ( ($)" + , " ( ($), (.)" ] , [ " , Bool(..)" | lay ] , [ " , Either(..)" , " , Int, (>)" - , " , String, (++), unlines" + , " , String, (++), concat, unlines" , " , Show, show" , " , IO, (>>), (>>=), mapM_, putStrLn" , " , FilePath" ] , [ " , getContents, readFile" | tokenText opts == StringToken ] - , [ " , (.), error, flip, map, replicate, sequence_, zip" | use_glr ] + , [ " , error, flip, map, replicate, sequence_, zip" | use_glr ] , [ " )" ] , case tokenText opts of StringToken -> [] @@ -316,7 +328,7 @@ , table "" $ concat [ [ [ "import " , absFileM opts , " (" ++ if_glr impTopCat ++ ")" ] ] , [ [ "import " , layoutFileM opts , " ( resolveLayout )" ] | lay ] - , [ [ "import " , alexFileM opts , " ( Token )" ] + , [ [ "import " , alexFileM opts , " ( Token, mkPosToken )" ] , [ "import " , happyFileM opts , " ( " ++ impParser ++ ", myLexer" ++ impParGLR ++ " )" ] , [ "import " , printerFileM opts , " ( Print, printTree )" ] , [ "import " , templateFileM opts , " ()" ] @@ -367,14 +379,14 @@ , "" ] , if_glr $ - [ "the_parser :: ParseFun " ++ show topType + [ "the_parser :: ParseFun " ++ catToStr topType , "the_parser = lift_parser " ++ render (parserName topType) , "" , liftParser ] ] where - lay = hasLayout cf + lay = isJust hasTopLevelLayout || not (null layoutKeywords) use_xml = xml opts > 0 xpr = if use_xml then "XPrint a, " else "" use_glr = glr opts == GLR @@ -386,8 +398,10 @@ impTopCat = unwords [ "", identCat topType, "" ] impParGLR = if_glr ", GLRResult(..), Branch, ForestId, TreeDecode(..), decode" myLLexer atom - | lay = unwords [ "resolveLayout True $ myLexer", atom] + | lay = unwords [ "resolveLayout", show useTopLevelLayout, "$ myLexer", atom] | True = unwords [ "myLexer", atom] + (hasTopLevelLayout, layoutKeywords, _) = layoutPragmas cf + useTopLevelLayout = isJust hasTopLevelLayout runStd xml myLLexer = unlines $ concat @@ -396,7 +410,8 @@ , " Left err -> do" , " putStrLn \"\\nParse Failed...\\n\"" , " putStrV v \"Tokens:\"" - , " putStrV v $ show ts" + , " mapM_ (putStrV v . showPosToken . mkPosToken) ts" + -- , " putStrV v $ show ts" , " putStrLn err" , " exitFailure" , " Right tree -> do" @@ -407,6 +422,7 @@ , [ " exitSuccess" , " where" , " ts = " ++ myLLexer "s" + , " showPosToken ((l,c),t) = concat [ show l, \":\", show c, \"\\t\", show t ]" ] ] diff --git a/src/BNFC/Backend/Haskell/CFtoAbstract.hs b/src/BNFC/Backend/Haskell/CFtoAbstract.hs --- a/src/BNFC/Backend/Haskell/CFtoAbstract.hs +++ b/src/BNFC/Backend/Haskell/CFtoAbstract.hs @@ -50,10 +50,10 @@ , [ "{-# LANGUAGE DeriveGeneric #-}" | gen ] , [ "{-# LANGUAGE DeriveTraversable #-}" | fun ] , [ "{-# LANGUAGE FlexibleInstances #-}" | fun ] - , [ "{-# LANGUAGE GeneralizedNewtypeDeriving #-}" | hasIdentLike ] -- for IsString + , [ "{-# LANGUAGE GeneralizedNewtypeDeriving #-}" | hasIdentLikeNoPos ] -- for IsString , [ "{-# LANGUAGE LambdaCase #-}" | fun ] , [ "{-# LANGUAGE PatternSynonyms #-}" | defPosition ] - , [ "{-# LANGUAGE OverloadedStrings #-}" | tokenText /= StringToken ] + , [ "{-# LANGUAGE OverloadedStrings #-}" | not (null definitions), tokenText /= StringToken ] ] ] , [ "-- | The abstract syntax of language" <+> text lang <> "." ] @@ -66,11 +66,11 @@ , [ prettyList 2 "import qualified Prelude as C" "(" ")" "," $ qualifiedPreludeImports | not $ null qualifiedPreludeImports ] , [ "import qualified Data.String" - | hasIdentLike ] -- for IsString + | hasIdentLikeNoPos ] -- for IsString ] ] , [ vcat . concat $ - [ map text $ tokenTextImport tokenText + [ when hasTextualToks $ map text $ tokenTextImport tokenText , [ "import qualified Data.Data as C (Data, Typeable)" | gen ] , [ "import qualified GHC.Generics as C (Generic)" | gen ] ] @@ -80,7 +80,7 @@ , map (prData functor (derivingClasses functor)) datas -- Smart constructors - , definedRules functor cf + , definitions -- Token definition types , (`map` specialCats cf) $ \ c -> @@ -105,7 +105,7 @@ | defPosition ] - -- HasPosition class if either @fun@ or @hasIdentLikeTokens@ + -- HasPosition class , [ vcat [ "-- | Get the start position of something." , "" @@ -122,15 +122,19 @@ , [ "" ] -- ensure final newline ] where + definitions = definedRules functor cf + datas = cf2data cf positionCats = filter (isPositionCat cf) $ specialCats cf - hasIdentLike = hasIdentLikeTokens cf + hasIdentLikeNoPos = hasIdentLikeTokens cf + hasTextualToks = hasTextualTokens cf + hasPosToks = hasPositionTokens cf hasData = not (null datas) -- @defPosition@: should the @BNCF'Position@ type be defined? - defPosition = hasPositionTokens cf || functor + defPosition = hasPosToks || functor -- @hasPosition@: should the @HasPosition@ class be defined? - hasPosition = hasPositionTokens cf || fun + hasPosition = hasPosToks || fun gen = generic && hasData fun = functor && hasData @@ -148,11 +152,11 @@ ] -- import Prelude (Char, Double, Integer, String) typeImports = - filter (\ s -> hasData && s `elem` cfgLiterals cf - || hasIdentLike && tokenText == StringToken && s == "String") + filter (\ s -> hasData && s `elem` cfgLiterals cf + || hasTextualToks && tokenText == StringToken && s == "String") baseTokenCatNames qualifiedPreludeImports = concat - [ [ text $ List.intercalate ", " stdClasses | hasIdentLike || hasData ] + [ [ text $ List.intercalate ", " stdClasses | hasTextualToks || hasData ] , [ text $ List.intercalate ", " funClasses | fun ] , [ text $ "Int, Maybe(..)" | defPosition ] ] @@ -194,7 +198,7 @@ ] where prRule (fun, cats) = hsep $ concat [ [text fun], ["a" | functor], map prArg cats ] - unprimedType = text (show cat) + unprimedType = pretty cat primedType = prime unprimedType prime = (<> "'") dataType | functor = primedType <+> "a" @@ -291,24 +295,26 @@ -- | Generate Haskell code for the @define@d constructors. definedRules :: Bool -> CF -> [Doc] -definedRules functor cf = [ mkDef f xs e | FunDef f xs e <- cfgPragmas cf ] +definedRules functor cf = map mkDef $ definitions cf where - mkDef f xs e = vcat $ map text $ concat - [ [ unwords [ fName, "::", typ $ wpThing t ] + mkDef (Define f args e t) = vcat $ concat + [ [ text $ unwords [ fName, "::", typ $ wpThing t ] | t <- maybeToList $ sigLookup f cf ] - , [ unwords $ fName : xs' ++ [ "=", show $ sanitize e ] ] + , [ hsep $ map text (fName : xs') ++ [ "=", pretty $ sanitize e ] ] ] where fName = mkDefName f + xs = map fst args avoidReserved = avoidReservedWords [fName] xs' = addFunctorArg id $ map avoidReserved xs typ (FunT ts t) | functor = List.intercalate " -> " $ "a" : (map funBase $ ts ++ [t]) typ t = typeToHaskell t sanitize = \case - App x es - | tokTyp x -> App x $ map sanitize es - | otherwise -> App x $ addFunctorArg (`App` []) $ map sanitize es + App x t es + | isNilCons x -> App x t $ map sanitize es + | tokTyp x -> App x t $ map sanitize es + | otherwise -> App x t $ addFunctorArg (\ e -> App e dummyType []) $ map sanitize es Var x -> Var $ avoidReserved x e@LitInt{} -> e e@LitDouble{} -> e diff --git a/src/BNFC/Backend/Haskell/CFtoAlex3.hs b/src/BNFC/Backend/Haskell/CFtoAlex3.hs --- a/src/BNFC/Backend/Haskell/CFtoAlex3.hs +++ b/src/BNFC/Backend/Haskell/CFtoAlex3.hs @@ -13,11 +13,12 @@ import BNFC.Abs import BNFC.CF -import BNFC.Lexing (mkRegMultilineComment) -import BNFC.Options (TokenText(..)) --- import BNFC.Utils (unless) +import BNFC.Lexing ( mkRegMultilineComment ) +import BNFC.Options ( TokenText(..) ) +import BNFC.PrettyPrint +import BNFC.Utils ( table, when, unless ) -import BNFC.Backend.Common (unicodeAndSymbols) +import BNFC.Backend.Common ( unicodeAndSymbols ) import BNFC.Backend.Haskell.Utils cf2alex3 :: String -> TokenText -> CF -> String @@ -36,6 +37,9 @@ , "{" , "{-# OPTIONS -fno-warn-incomplete-patterns #-}" , "{-# OPTIONS_GHC -w #-}" + , "" + , "{-# LANGUAGE PatternSynonyms #-}" + , "" , "module " ++ name ++ " where" , "" , "import Prelude" @@ -43,16 +47,20 @@ ] , tokenTextImport tokenText , [ "import qualified Data.Bits" - , "import Data.Word (Word8)" - , "import Data.Char (ord)" + , "import Data.Char (ord)" + , "import Data.Function (on)" + , "import Data.Word (Word8)" , "}" - , "" ] ] +-- | Character class definitions. + cMacros :: [String] cMacros = - [ "$c = [A-Z\\192-\\221] # [\\215] -- capital isolatin1 letter (215 = \\times) FIXME" + [ "-- 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" @@ -60,269 +68,344 @@ , "$u = [. \\n] -- universal: any character" ] +-- | Regular expressions and lex actions. + rMacros :: CF -> [String] -rMacros cf = if null symbs then [] else - [ "@rsyms = -- symbols and non-identifier-like reserved words" - , " " ++ List.intercalate " | " (map mkEsc symbs) +rMacros cf = unless (null symbs) + [ "-- Symbols and non-identifier-like reserved words" + , "" + , "@rsyms = " ++ List.intercalate " | " (map (unwords . esc) symbs) ] where symbs = unicodeAndSymbols cf - mkEsc = unwords . esc + esc :: String -> [String] esc s = if null a then rest else show a : rest - where (a,r) = span (\ c -> isAscii c && isAlphaNum c) s - rest = case r of - [] -> [] - (c:xs) -> s : esc xs - where s = if isPrint c then ['\\',c] - else '\\':show (ord c) + where + (a, r) = span (\ c -> isAscii c && isAlphaNum c) s + rest = case r of + [] -> [] + c : xs -> (if isPrint c then ['\\',c] else '\\' : show (ord c)) : esc xs restOfAlex :: TokenText -> CF -> [String] -restOfAlex tokenText cf = [ - ":-", - "", - lexComments (comments cf), - "$white+ ;", - pTSpec (unicodeAndSymbols cf), - - userDefTokenTypes, - ident, - - ifC catString ("\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t | r | f)))* \\\"" ++ - "\n { tok (\\p s -> PT p (TL $ unescapeInitTail s)) }"), - ifC catChar "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t r f]) \\'\n { tok (\\p s -> PT p (TC s)) }", - ifC catInteger "$d+\n { tok (\\p s -> PT p (TI s)) }", - ifC catDouble "$d+ \\. $d+ (e (\\-)? $d+)?\n { tok (\\p s -> PT p (TD s)) }", - "", - "{", - "", - "tok :: (Posn -> " ++ stringType ++ " -> Token) -> (Posn -> " ++ stringType ++ " -> Token)", - "tok f p s = f p s", - "", - "data Tok =", - " TS !"++stringType++" !Int -- reserved words and symbols", - " | TL !"++stringType++" -- string literals", - " | TI !"++stringType++" -- integer literals", - " | TV !"++stringType++" -- identifiers", - " | TD !"++stringType++" -- double precision float literals", - " | TC !"++stringType++" -- character literals", - userDefTokenConstrs, - " deriving (Eq,Show,Ord)", - "", - "data Token =", - " PT Posn Tok", - " | Err Posn", - " deriving (Eq,Show,Ord)", - "", - "printPosn :: Posn -> String", - "printPosn (Pn _ l c) = \"line \" ++ show l ++ \", column \" ++ show c", - "", - "tokenPos :: [Token] -> String", - "tokenPos (t:_) = printPosn (tokenPosn t)", - "tokenPos [] = \"end of file\"", - "", - "tokenPosn :: Token -> Posn", - "tokenPosn (PT p _) = p", - "tokenPosn (Err p) = p", - "", - "tokenLineCol :: Token -> (Int, Int)", - "tokenLineCol = posLineCol . tokenPosn", - "", - "posLineCol :: Posn -> (Int, Int)", - "posLineCol (Pn _ l c) = (l,c)", - "", - "mkPosToken :: Token -> ((Int, Int), " ++ stringType ++ ")", - "mkPosToken t@(PT p _) = (posLineCol p, tokenText t)", - "", - "tokenText :: Token -> " ++ stringType, - "tokenText t = case t of", - " PT _ (TS s _) -> s", - " PT _ (TL s) -> " ++ applyP stringPack "show s", - " PT _ (TI s) -> s", - " PT _ (TV s) -> s", - " PT _ (TD s) -> s", - " PT _ (TC s) -> s", - " Err _ -> " ++ apply stringPack "\"#error\"", - userDefTokenPrint, - "prToken :: Token -> String", - "prToken t = " ++ applyP stringUnpack "tokenText t", - "", - "data BTree = N | B "++stringType++" Tok BTree BTree deriving (Show)", - "", - "eitherResIdent :: ("++stringType++" -> Tok) -> "++stringType++" -> Tok", - "eitherResIdent tv s = treeFind resWords", - " where", - " treeFind N = tv s", - " treeFind (B a t left right) | s < a = treeFind left", - " | s > a = treeFind right", - " | s == a = t", - "", - "resWords :: BTree", - "resWords = " ++ show (sorted2tree $ cfTokens cf), - " where b s n = let bs = "++ apply stringPack "s", - " in B bs (TS bs n)", - "", - "unescapeInitTail :: "++stringType++" -> "++stringType++"", - "unescapeInitTail = "++stringPack++" . unesc . tail . "++stringUnpack, - " where", - " unesc s = case s of", - " '\\\\':c:cs | elem c ['\\\"', '\\\\', '\\\''] -> c : unesc cs", - " '\\\\':'n':cs -> '\\n' : unesc cs", - " '\\\\':'t':cs -> '\\t' : unesc cs", - " '\\\\':'r':cs -> '\\r' : unesc cs", - " '\\\\':'f':cs -> '\\f' : unesc cs", - " '\"':[] -> []", - " c:cs -> c : unesc cs", - " _ -> []", - "", - "-------------------------------------------------------------------", - "-- Alex wrapper code.", - "-- A modified \"posn\" wrapper.", - "-------------------------------------------------------------------", - "", - "data Posn = Pn !Int !Int !Int", - " deriving (Eq, Show,Ord)", - "", - "alexStartPos :: Posn", - "alexStartPos = Pn 0 1 1", - "", - "alexMove :: Posn -> Char -> Posn", - "alexMove (Pn a l c) '\\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)", - "alexMove (Pn a l c) '\\n' = Pn (a+1) (l+1) 1", - "alexMove (Pn a l c) _ = Pn (a+1) l (c+1)", - "", - "type Byte = Word8", - "", - "type AlexInput = (Posn, -- current position,", - " Char, -- previous char", - " [Byte], -- pending bytes on the current char", - " "++stringType++") -- current input string", - "", - "tokens :: "++stringType++" -> [Token]", - "tokens str = go (alexStartPos, '\\n', [], str)", - " where", - " go :: AlexInput -> [Token]", - " go inp@(pos, _, _, str) =", - " case alexScan inp 0 of", - " AlexEOF -> []", - " AlexError (pos, _, _, _) -> [Err pos]", - " AlexSkip inp' len -> go inp'", - " AlexToken inp' len act -> act pos ("++stringTake++" len str) : (go inp')", - "", - "alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)", - "alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))", - "alexGetByte (p, _, [], s) =", - " case " ++ apply stringUncons "s" ++ " of", - " "++stringNilP++" -> Nothing", - " "++stringConsP++" ->", - " let p' = alexMove p c", - " (b:bs) = utf8Encode c", - " in p' `seq` Just (b, (p', c, bs, s))", - "", - "alexInputPrevChar :: AlexInput -> Char", - "alexInputPrevChar (p, c, bs, s) = c", - "", - "-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.", - "utf8Encode :: Char -> [Word8]", - "utf8Encode = map fromIntegral . go . ord", - " where", - " go oc", - " | oc <= 0x7f = [oc]", - "", - " | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6)", - " , 0x80 + oc Data.Bits..&. 0x3f", - " ]", - "", - " | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12)", - " , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)", - " , 0x80 + oc Data.Bits..&. 0x3f", - " ]", - " | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18)", - " , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)", - " , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)", - " , 0x80 + oc Data.Bits..&. 0x3f", - " ]", - "}" +restOfAlex tokenText cf = concat + [ [ ":-" + , "" + ] + , lexComments $ comments cf + , [ "-- Whitespace (skipped)" + , "$white+ ;" + , "" + ] + , unless (null $ unicodeAndSymbols cf) + [ "-- Symbols" + , "@rsyms" + , " { tok (eitherResIdent TV) }" + , "" + ] + , userDefTokenTypes + , [ "-- Keywords and Ident" + , "$l $i*" + , " { tok (eitherResIdent TV) }" + , "" + ] + , ifC catString + [ "-- String" + , "\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t | r | f)))* \\\"" + , " { tok (TL . unescapeInitTail) }" + , "" + ] + , ifC catChar + [ "-- Char" + , "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t r f]) \\'" + , " { tok TC }" + , "" + ] + , ifC catInteger + [ "-- Integer" + , "$d+" + , " { tok TI }" + , "" + ] + , ifC catDouble + [ "-- Double" + , "$d+ \\. $d+ (e (\\-)? $d+)?" + , " { tok TD }" + , "" + ] + , [ "{" + , "-- | Create a token with position." + , "tok :: (" ++ stringType ++ " -> Tok) -> (Posn -> " ++ stringType ++ " -> Token)" + , "tok f p = PT p . f" + , "" + , "-- | Token without position." + , "data Tok" + ] + , map (" " ++) $ table " " $ + [ [ "= TK {-# UNPACK #-} !TokSymbol", "-- ^ Reserved word or symbol." ] + , [ "| TL !" ++ stringType , "-- ^ String literal." ] + , [ "| TI !" ++ stringType , "-- ^ Integer literal." ] + , [ "| TV !" ++ stringType , "-- ^ Identifier." ] + , [ "| TD !" ++ stringType , "-- ^ Float literal." ] + , [ "| TC !" ++ stringType , "-- ^ Character literal." ] + ] + , [ " | T_" ++ name ++ " !" ++ stringType | name <- tokenNames cf ] + , [ " deriving (Eq, Show, Ord)" + , "" + , "-- | Smart constructor for 'Tok' for the sake of backwards compatibility." + , "pattern TS :: " ++ stringType ++ " -> Int -> Tok" + , "pattern TS t i = TK (TokSymbol t i)" + , "" + , "-- | Keyword or symbol tokens have a unique ID." + , "data TokSymbol = TokSymbol" + , " { tsText :: " ++ stringType + , " -- ^ Keyword or symbol text." + , " , tsID :: !Int" + , " -- ^ Unique ID." + , " } deriving (Show)" + , "" + , "-- | Keyword/symbol equality is determined by the unique ID." + , "instance Eq TokSymbol where (==) = (==) `on` tsID" + , "" + , "-- | Keyword/symbol ordering is determined by the unique ID." + , "instance Ord TokSymbol where compare = compare `on` tsID" + , "" + , "-- | Token with position." + , "data Token" + , " = PT Posn Tok" + , " | Err Posn" + , " deriving (Eq, Show, Ord)" + , "" + , "-- | Pretty print a position." + , "printPosn :: Posn -> String" + , "printPosn (Pn _ l c) = \"line \" ++ show l ++ \", column \" ++ show c" + , "" + , "-- | Pretty print the position of the first token in the list." + , "tokenPos :: [Token] -> String" + , "tokenPos (t:_) = printPosn (tokenPosn t)" + , "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)" + , "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), " ++ stringType ++ ")" + , "mkPosToken t = (tokenLineCol t, tokenText t)" + , "" + , "-- | Convert a token to its text." + , "tokenText :: Token -> " ++ stringType + , "tokenText t = case t of" + , " PT _ (TS s _) -> s" + , " PT _ (TL s) -> " ++ applyP stringPack "show s" + , " PT _ (TI s) -> s" + , " PT _ (TV s) -> s" + , " PT _ (TD s) -> s" + , " PT _ (TC s) -> s" + , " Err _ -> " ++ apply stringPack "\"#error\"" + ] + , [ " PT _ (T_" ++ name ++ " s) -> s" | name <- tokenNames cf ] + , [ "" + , "-- | Convert a token to a string." + , "prToken :: Token -> String" + , "prToken t = " ++ applyP stringUnpack "tokenText t" + , "" + , "-- | Finite map from text to token organized as binary search tree." + , "data BTree" + , " = N -- ^ Nil (leaf)." + , " | B " ++ stringType ++ " Tok BTree BTree" + , " -- ^ Binary node." + , " deriving (Show)" + , "" + , "-- | Convert potential keyword into token or use fallback conversion." + , "eitherResIdent :: (" ++ stringType ++ " -> Tok) -> " ++ stringType ++ " -> 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" + , "" + , "-- | The keywords and symbols of the language organized as binary search tree." + , "resWords :: BTree" + , render $ hang "resWords =" 2 $ pretty $ sorted2tree tokens + ] + , unless (null tokens) + [ " where" + , " b s n = B bs (TS bs n)" + , " where" + , " bs = "++ apply stringPack "s" + ] + , [ "" + , "-- | Unquote string literal." + , "unescapeInitTail :: " ++ stringType ++ " -> " ++ stringType ++ "" + , "unescapeInitTail = " ++ stringPack ++ " . unesc . tail . " ++ stringUnpack + , " where" + , " unesc s = case s of" + , " '\\\\':c:cs | elem c ['\\\"', '\\\\', '\\\''] -> c : unesc cs" + , " '\\\\':'n':cs -> '\\n' : unesc cs" + , " '\\\\':'t':cs -> '\\t' : unesc cs" + , " '\\\\':'r':cs -> '\\r' : unesc cs" + , " '\\\\':'f':cs -> '\\f' : unesc cs" + , " '\"':[] -> []" + , " c:cs -> c : unesc cs" + , " _ -> []" + , "" + , "-------------------------------------------------------------------" + , "-- Alex wrapper code." + , "-- A modified \"posn\" wrapper." + , "-------------------------------------------------------------------" + , "" + , "data Posn = Pn !Int !Int !Int" + , " deriving (Eq, Show, Ord)" + , "" + , "alexStartPos :: Posn" + , "alexStartPos = Pn 0 1 1" + , "" + , "alexMove :: Posn -> Char -> Posn" + , "alexMove (Pn a l c) '\\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)" + , "alexMove (Pn a l c) '\\n' = Pn (a+1) (l+1) 1" + , "alexMove (Pn a l c) _ = Pn (a+1) l (c+1)" + , "" + , "type Byte = Word8" + , "" + , "type AlexInput = (Posn, -- current position," + , " Char, -- previous char" + , " [Byte], -- pending bytes on the current char" + , " " ++ stringType ++ ") -- current input string" + , "" + , "tokens :: " ++ stringType ++ " -> [Token]" + , "tokens str = go (alexStartPos, '\\n', [], str)" + , " where" + , " go :: AlexInput -> [Token]" + , " go inp@(pos, _, _, str) =" + , " case alexScan inp 0 of" + , " AlexEOF -> []" + , " AlexError (pos, _, _, _) -> [Err pos]" + , " AlexSkip inp' len -> go inp'" + , " AlexToken inp' len act -> act pos (" ++ stringTake ++ " len str) : (go inp')" + , "" + , "alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)" + , "alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))" + , "alexGetByte (p, _, [], s) =" + , " case " ++ apply stringUncons "s" ++ " of" + , " " ++ stringNilP ++ " -> Nothing" + , " " ++ stringConsP ++ " ->" + , " let p' = alexMove p c" + , " (b:bs) = utf8Encode c" + , " in p' `seq` Just (b, (p', c, bs, s))" + , "" + , "alexInputPrevChar :: AlexInput -> Char" + , "alexInputPrevChar (p, c, bs, s) = c" + , "" + , "-- | Encode a Haskell String to a list of Word8 values, in UTF8 format." + , "utf8Encode :: Char -> [Word8]" + , "utf8Encode = map fromIntegral . go . ord" + , " where" + , " go oc" + , " | oc <= 0x7f = [oc]" + , "" + , " | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6)" + , " , 0x80 + oc Data.Bits..&. 0x3f" + , " ]" + , "" + , " | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12)" + , " , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)" + , " , 0x80 + oc Data.Bits..&. 0x3f" + , " ]" + , " | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18)" + , " , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)" + , " , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)" + , " , 0x80 + oc Data.Bits..&. 0x3f" + , " ]" + , "}" + ] ] - where - (stringType,stringTake,stringUncons,stringPack,stringUnpack,stringNilP,stringConsP) = case tokenText of - StringToken -> ("String", "take", "", "id", "id", "[]", "(c:s)" ) - ByteStringToken -> ("BS.ByteString", "BS.take", "BS.uncons", "BS.pack", "BS.unpack", "Nothing", "Just (c,s)") - TextToken -> ("Data.Text.Text", "Data.Text.take", "Data.Text.uncons", "Data.Text.pack", "Data.Text.unpack", "Nothing", "Just (c,s)") - - apply :: String -> String -> String - apply "" s = s - apply "id" s = s - apply f s = f ++ " " ++ s - - applyP :: String -> String -> String - applyP "" s = s - applyP "id" s = s - applyP f s = f ++ " (" ++ s ++ ")" - - ifC :: TokenCat -> String -> String - ifC cat s = if isUsedCat cf (TokenCat cat) then s else "" - - lexComments - :: ( [(String, String)] -- block comment delimiters - , [String] -- line comment initiators - ) -> String -- Alex declarations - lexComments (block, line) = unlines $ concat $ - [ [ "-- Line comments" | not (null line) ] - , map lexLineComment line - , [ "" | not (null line || null block) ] - , [ "-- Block comments" | not (null block) ] - , map (uncurry lexBlockComment) block - ] + where + (stringType, stringTake, stringUncons, stringPack, stringUnpack, stringNilP, stringConsP) = + case tokenText of + StringToken -> ("String", "take", "", "id", "id", "[]", "(c:s)" ) + ByteStringToken -> ("BS.ByteString", "BS.take", "BS.uncons", "BS.pack", "BS.unpack", "Nothing", "Just (c,s)") + TextToken -> ("Data.Text.Text", "Data.Text.take", "Data.Text.uncons", "Data.Text.pack", "Data.Text.unpack", "Nothing", "Just (c,s)") - lexLineComment - :: String -- ^ Line comment start. - -> String -- ^ Alex declaration. - lexLineComment s = concat [ "\"", s, "\" [.]* ;" ] + apply :: String -> String -> String + apply "" s = s + apply "id" s = s + apply f s = f ++ " " ++ s - lexBlockComment - :: String -- ^ Start of block comment. - -> String -- ^ End of block comment. - -> String -- ^ Alex declaration. - lexBlockComment start end = printRegAlex (mkRegMultilineComment start end) ++ " ;" + applyP :: String -> String -> String + applyP "" s = s + applyP "id" s = s + applyP f s = f ++ " (" ++ s ++ ")" - -- tokens consisting of special symbols - pTSpec [] = "" - pTSpec _ = "@rsyms\n { tok (\\p s -> PT p (eitherResIdent TV s)) }" + ifC :: Monoid m => TokenCat -> m -> m + ifC = when . isUsedCat cf . TokenCat - userDefTokenTypes = unlines - [ printRegAlex exp ++ - "\n { tok (\\p s -> PT p (eitherResIdent T_" ++ name ++ " s)) }" - | (name,exp) <- tokenPragmas cf - ] + lexComments + :: ( [(String, String)] -- block comment delimiters + , [String] -- line comment initiators + ) -> [String] -- Alex declarations + lexComments (block, line) = concat $ + [ concatMap lexLineComment line + , concatMap (uncurry lexBlockComment) block + ] - userDefTokenConstrs = unlines - [ " | T_" ++ name ++ " !"++stringType - | name <- tokenNames cf - ] + lexLineComment + :: String -- ^ Line comment start. + -> [String] -- ^ Alex declaration. + lexLineComment s = + [ unwords [ "-- Line comment", show s ] + , concat [ "\"", s, "\" [.]* ;" ] + , "" + ] - userDefTokenPrint = unlines - [ " PT _ (T_" ++ name ++ " s) -> s" - | name <- tokenNames cf - ] + lexBlockComment + :: String -- ^ Start of block comment. + -> String -- ^ End of block comment. + -> [String] -- ^ Alex declaration. + lexBlockComment start end = + [ unwords [ "-- Block comment", show start, show end ] + , printRegAlex (mkRegMultilineComment start end) ++ " ;" + , "" + ] - ident = - "$l $i*\n { tok (\\p s -> PT p (eitherResIdent TV s)) }" - --ifC "Ident" " ::= ^l ^i* { ident p = PT p . eitherResIdent TV }" + userDefTokenTypes :: [String] + userDefTokenTypes = concat + [ [ "-- token " ++ name + , printRegAlex exp + , " { tok (eitherResIdent T_" ++ name ++ ") }" + , "" + ] + | (name, exp) <- tokenPragmas cf + ] + tokens = cfTokens cf -data BTree = N | B String Int BTree BTree +-- | Binary search tree. +data BTree a + = N + | B String a (BTree a) (BTree a) -instance Show BTree where - showsPrec _ N = showString "N" - showsPrec n (B s k l r) = mparens - $ showString "b " . shows s - . showChar ' ' . shows k - . showChar ' ' . showsPrec 1 l - . showChar ' ' . showsPrec 1 r - where - mparens f = if n > 0 then showChar '(' . f . showChar ')' else f +instance Pretty a => Pretty (BTree a) where + prettyPrec _ N = text "N" + prettyPrec n (B k v l r) = parensIf (n > 0) $ + hang ("b" <+> text (show k) <+> pretty v) 2 $ sep + [ prettyPrec 1 l + , prettyPrec 1 r + ] -sorted2tree :: [(String,Int)] -> BTree +-- | Create a balanced search tree from a sorted list. +sorted2tree :: [(String,a)] -> BTree a sorted2tree [] = N sorted2tree xs = B x n (sorted2tree t1) (sorted2tree t2) where @@ -338,16 +421,16 @@ -- the top-level printing method printRegAlex :: Reg -> String -printRegAlex = render . prt 0 +printRegAlex = render' . prt 0 -render :: [String] -> String -render = \case - "[" : ts -> cons "[" $ render ts - "(" : ts -> cons "(" $ render ts - t : "," : ts -> cons t $ space "," $ render ts - t : ")" : ts -> cons t $ cons ")" $ render ts - t : "]" : ts -> cons t $ cons "]" $ render ts - t : ts -> space t $ render ts +render' :: [String] -> String +render' = \case + "[" : ts -> cons "[" $ render' ts + "(" : ts -> cons "(" $ render' ts + t : "," : ts -> cons t $ space "," $ render' ts + t : ")" : ts -> cons t $ cons ")" $ render' ts + t : "]" : ts -> cons t $ cons "]" $ render' ts + t : ts -> space t $ render' ts _ -> "" where cons s t = s ++ t diff --git a/src/BNFC/Backend/Haskell/CFtoHappy.hs b/src/BNFC/Backend/Haskell/CFtoHappy.hs --- a/src/BNFC/Backend/Haskell/CFtoHappy.hs +++ b/src/BNFC/Backend/Haskell/CFtoHappy.hs @@ -50,6 +50,7 @@ , delimiter , specialRules absName functor tokenText cf , render $ prRules absName functor (rulesForHappy absName functor cf) + , "" , footer absName tokenText functor eps cf ] where @@ -61,6 +62,8 @@ [ [ "-- This Happy file was machine-generated by the BNF converter" , "{" , "{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}" + , "{-# LANGUAGE PatternSynonyms #-}" + , "" , "module " ++ modName , " ( happyError" , " , myLexer" @@ -117,10 +120,10 @@ -- Andreas, 2019-01-02: "%token" followed by nothing is a Happy parse error. -- Thus, if we have no tokens, do not output anything. | null ts = empty - | otherwise = "%token" $$ (nest 2 $ vcat ts) + | otherwise = "%token" $$ (nest 2 $ vcat $ map text $ table " " ts) where - ts = map prToken (cfTokens cf) ++ map text (specialToks cf functor) - prToken (t,k) = hsep [ convert t, lbrace, text ("PT _ (TS _ " ++ show k ++ ")"), rbrace ] + ts = map prToken (cfTokens cf) ++ specialToks cf functor + prToken (t,k) = [ render (convert t), "{ PT _ (TS _ " ++ show k ++ ")", "}" ] -- Happy doesn't allow characters such as åäö to occur in the happy file. This -- is however not a restriction, just a naming paradigm in the happy source file. @@ -204,13 +207,18 @@ -- Expr : Integer { Foo.EInt $1 } | Expr '+' Expr { Foo.EPlus $1 $3 } -- -- if there's a lot of cases, print on several lines: --- >>> prRules "" False [(Cat "Expr", [("Abcd", "Action"), ("P2", "A2"), ("P3", "A3"), ("P4", "A4"), ("P5","A5")])] +-- >>> prRules "" False [(Cat "Expr", [("Abcd", "Action"), ("P2", "A2"), ("P3", "A3"), ("P4", "A4"), ("P5","A5"), ("P6", "A6"), ("P7", "A7"), ("P8", "A8"), ("P9","A9")])] -- Expr :: { Expr } --- Expr : Abcd { Action } --- | P2 { A2 } --- | P3 { A3 } --- | P4 { A4 } --- | P5 { A5 } +-- Expr +-- : Abcd { Action } +-- | P2 { A2 } +-- | P3 { A3 } +-- | P4 { A4 } +-- | P5 { A5 } +-- | P6 { A6 } +-- | P7 { A7 } +-- | P8 { A8 } +-- | P9 { A9 } -- -- >>> prRules "" False [(Cat "Internal", [])] -- nt has only internal use -- @@ -231,14 +239,15 @@ prRules absM functor = vsep . map prOne where prOne (_ , [] ) = empty -- nt has only internal use - prOne (nt, (p,a):ls) = - hsep [ nt', "::", "{", if functor then functorType' nt else type' nt, "}" ] - $$ nt' <+> sep (pr ":" (p, a) : map (pr "|") ls) + prOne (nt, (p,a):ls) = vcat + [ hsep [ nt', "::", "{", if functor then functorType' nt else type' nt, "}" ] + , hang nt' 2 $ sep (pr ":" (p, a) : map (pr "|") ls) + ] where - nt' = text (identCat nt) + nt' = text (identCat nt) pr pre (p,a) = hsep [pre, text p, "{", text a , "}"] - type' = catToType qualify empty - functorType' nt = hcat ["(", qualify posType, ", ", type' nt, ")"] + type' = catToType qualify empty + functorType' nt = hcat ["(", qualify posType, ", ", type' nt, ")"] qualify | null absM = id | otherwise = ((text absM <> ".") <>) @@ -285,14 +294,14 @@ | otherwise = ((text absName <> ".") <>) -- | GF literals. -specialToks :: CF -> Bool -> [String] +specialToks :: CF -> Bool -> [[String]] -- ^ A table with three columns (last is "}"). specialToks cf functor = (`map` literals cf) $ \t -> case t of - "Ident" -> "L_Ident { PT _ (TV " ++ posn t ++ ") }" - "String" -> "L_quoted { PT _ (TL " ++ posn t ++ ") }" - "Integer" -> "L_integ { PT _ (TI " ++ posn t ++ ") }" - "Double" -> "L_doubl { PT _ (TD " ++ posn t ++ ") }" - "Char" -> "L_charac { PT _ (TC " ++ posn t ++ ") }" - own -> "L_" ++ own ++ " { PT _ (T_" ++ own ++ " " ++ posn own ++ ") }" + "Ident" -> [ "L_Ident" , "{ PT _ (TV " ++ posn t ++ ")", "}" ] + "String" -> [ "L_quoted", "{ PT _ (TL " ++ posn t ++ ")", "}" ] + "Integer" -> [ "L_integ ", "{ PT _ (TI " ++ posn t ++ ")", "}" ] + "Double" -> [ "L_doubl ", "{ PT _ (TD " ++ posn t ++ ")", "}" ] + "Char" -> [ "L_charac", "{ PT _ (TC " ++ posn t ++ ")", "}" ] + own -> [ "L_" ++ own,"{ PT _ (T_" ++ own ++ " " ++ posn own ++ ")", "}" ] where posn tokenCat = if isPositionCat cf tokenCat || functor then "_" else "$$" diff --git a/src/BNFC/Backend/Haskell/CFtoLayout.hs b/src/BNFC/Backend/Haskell/CFtoLayout.hs --- a/src/BNFC/Backend/Haskell/CFtoLayout.hs +++ b/src/BNFC/Backend/Haskell/CFtoLayout.hs @@ -7,283 +7,344 @@ module BNFC.Backend.Haskell.CFtoLayout where -import Data.List (sort) +import Data.Maybe ( fromMaybe ) + import BNFC.CF -import BNFC.Options (TokenText(..)) -import BNFC.Backend.Haskell.Utils +import BNFC.Options ( TokenText ) +import BNFC.PrettyPrint +import BNFC.Utils ( caseMaybe, for, whenJust ) -layoutOpen = "{" -layoutClose = "}" -layoutSep = ";" +data TokSymbol = TokSymbol String Int + deriving Show -cf2Layout :: TokenText -> String -> String -> CF -> String -cf2Layout tokenText layName lexName cf = unlines $ [ - "module " ++ layName ++ " where", - "", - "import Prelude", - "", - "import " ++ lexName, - "", - if tokenText == TextToken then "import qualified Data.Text" else "", - "import Data.Maybe (isNothing, fromJust)", - "", - "-- Generated by the BNF Converter", - "", - "-- local parameters", - "", - "", - "topLayout :: Bool", - "topLayout = " ++ show top, - "", - "layoutWords, layoutStopWords :: [String]", - "layoutWords = " ++ show lay, - "layoutStopWords = " ++ show stop, - "", - "-- layout separators", - "", - "", - "layoutOpen, layoutClose, layoutSep :: String", - "layoutOpen = " ++ show layoutOpen, - "layoutClose = " ++ show layoutClose, - "layoutSep = " ++ show layoutSep, - "", - "-- | Replace layout syntax with explicit layout tokens.", - "resolveLayout :: Bool -- ^ Whether to use top-level layout.", - " -> [Token] -> [Token]", - "resolveLayout tp = res Nothing [if tl then Implicit 1 else Explicit]", - " where", - " -- Do top-level layout if the function parameter and the grammar say so.", - " tl = tp && topLayout", - "", - " res :: Maybe Token -- ^ The previous token, if any.", - " -> [Block] -- ^ A stack of layout blocks.", - " -> [Token] -> [Token]", - "", - " -- The stack should never be empty.", - " res _ [] ts = error $ \"Layout error: stack empty. Tokens: \" ++ show ts", - "", - " res _ st (t0:ts)", - " -- We found an open brace in the input,", - " -- put an explicit layout block on the stack.", - " -- This is done even if there was no layout word,", - " -- to keep opening and closing braces.", - " | isLayoutOpen t0 = moveAlong (Explicit:st) [t0] ts", - "", - " -- We are in an implicit layout block", - " res pt (Implicit n:ns) (t0:ts)", - "", - " -- End of implicit block by a layout stop word", - " | isStop t0 =", - " -- Exit the current block and all implicit blocks", - " -- more indented than the current token", - " let (ebs,ns') = span (`moreIndent` column t0) ns", - " moreIndent (Implicit x) y = x > y", - " moreIndent Explicit _ = False", - " -- the number of blocks exited", - " b = 1 + length ebs", - " bs = replicate b layoutClose", - " -- Insert closing braces after the previous token.", - " (ts1,ts2) = splitAt (1+b) $ addTokens (afterPrev pt) bs (t0:ts)", - " in moveAlong ns' ts1 ts2", - "", - " -- End of an implicit layout block", - " | newLine pt t0 && column t0 < n = ", - " -- Insert a closing brace after the previous token.", - " let b:t0':ts' = addToken (afterPrev pt) layoutClose (t0:ts)", - " -- Repeat, with the current block removed from the stack", - " in moveAlong ns [b] (t0':ts')", - "", - " res pt st (t0:ts)", - " -- Start a new layout block if the first token is a layout word", - " | isLayout t0 =", - " case ts of", - " -- Explicit layout, just move on. The case above", - " -- will push an explicit layout block.", - " t1:_ | isLayoutOpen t1 -> moveAlong st [t0] ts", - " -- The column of the next token determines the starting column", - " -- of the implicit layout block.", - " -- However, the next block needs to be strictly more indented", - " -- than the previous block.", - " _ -> let col = max (indentation st + 1) $", - " -- at end of file, the start column doesn't matter", - " if null ts then column t0 else column (head ts)", - " -- insert an open brace after the layout word", - " b:ts' = addToken (nextPos t0) layoutOpen ts", - " -- save the start column", - " st' = Implicit col:st ", - " in -- Do we have to insert an extra layoutSep?", - " case st of", - " Implicit n:_", - " | newLine pt t0 && column t0 == n", - " && not (isNothing pt ||", - " isTokenIn [layoutSep,layoutOpen] (fromJust pt)) ->", - " let b':t0':b'':_ =", - " addToken (afterPrev pt) layoutSep (t0:b:ts')", - " in moveAlong st' [b',t0',b''] ts'", - " _ -> moveAlong st' [t0,b] ts'", - "", - " -- If we encounter a closing brace, exit the first explicit layout block.", - " | isLayoutClose t0 = ", - " let st' = drop 1 (dropWhile isImplicit st)", - " in if null st' ", - " then error $ \"Layout error: Found \" ++ layoutClose ++ \" at (\" ", - " ++ show (line t0) ++ \",\" ++ show (column t0) ", - " ++ \") without an explicit layout block.\"", - " else moveAlong st' [t0] ts", - "", - " -- Insert separator if necessary.", - " res pt st@(Implicit n : _) (t0:ts)", - " -- Encounted a new line in an implicit layout block.", - " | newLine pt t0 && column t0 == n = ", - " -- Insert a semicolon after the previous token.", - " -- unless we are the beginning of the file,", - " -- or the previous token is a semicolon or open brace.", - " if isNothing pt || isTokenIn [layoutSep,layoutOpen] (fromJust pt)", - " then moveAlong st [t0] ts", - " else let b:t0':ts' = addToken (afterPrev pt) layoutSep (t0:ts)", - " in moveAlong st [b,t0'] ts'", - "", - " -- Nothing to see here, move along.", - " res _ st (t:ts) = moveAlong st [t] ts", - "", - " -- At EOF: skip explicit blocks.", - " res (Just t) (Explicit:bs) [] | null bs = []", - " | otherwise = res (Just t) bs []", - "", - " -- If we are using top-level layout, insert a semicolon after", - " -- the last token, if there isn't one already", - " res (Just t) [Implicit _n] []", - " | isTokenIn [layoutSep] t = []", - " | otherwise = addToken (nextPos t) layoutSep []", - "", - " -- At EOF in an implicit, non-top-level block: close the block", - " res (Just t) (Implicit _ : bs) [] =", - " let c = addToken (nextPos t) layoutClose []", - " in moveAlong bs c []", - "", - " -- This should only happen if the input is empty.", - " res Nothing _st [] = []", - "", - " -- | Move on to the next token.", - " moveAlong :: [Block] -- ^ The layout stack.", - " -> [Token] -- ^ Any tokens just processed.", - " -> [Token] -- ^ the rest of the tokens.", - " -> [Token]", - " moveAlong _ [] _ = error \"Layout error: moveAlong got [] as old tokens\"", - " moveAlong st ot ts = ot ++ res (Just $ last ot) st ts", - "", - " newLine :: Maybe Token -> Token -> Bool", - " newLine pt t0 = case pt of", - " Nothing -> True", - " Just t -> line t /= line t0", - "", - "data Block", - " = Implicit Int -- ^ An implicit layout block with its start column.", - " | Explicit", - " deriving Show", - "", - "-- | Get current indentation. 0 if we are in an explicit block.", - "indentation :: [Block] -> Int", - "indentation (Implicit n : _) = n", - "indentation _ = 0", - "", - "-- | Check if s block is implicit.", - "isImplicit :: Block -> Bool", - "isImplicit (Implicit _) = True", - "isImplicit _ = False", - "", - "type Position = Posn", - "", - "-- | Insert a number of tokens at the begninning of a list of tokens.", - "addTokens :: Position -- ^ Position of the first new token.", - " -> [String] -- ^ Token symbols.", - " -> [Token] -- ^ The rest of the tokens. These will have their", - " -- positions updated to make room for the new tokens .", - " -> [Token]", - "addTokens p ss ts = foldr (addToken p) ts ss", - "", - "-- | Insert a new symbol token at the begninning of a list of tokens.", - "addToken :: Position -- ^ Position of the new token.", - " -> String -- ^ Symbol in the new token.", - " -> [Token] -- ^ The rest of the tokens. These will have their", - " -- positions updated to make room for the new token.", " -> [Token]", - "addToken p s ts = sToken p s : map (incrGlobal p (length s)) ts", - "", - "-- | Get the position immediately to the right of the given token.", - "-- If no token is given, gets the first position in the file.", - "afterPrev :: Maybe Token -> Position", - "afterPrev = maybe (Pn 0 1 1) nextPos", - "", - "-- | Get the position immediately to the right of the given token.", - "nextPos :: Token -> Position", - "nextPos t = Pn (g + s) l (c + s + 1)", - " where Pn g l c = position t", - " s = tokenLength t", - "", - "-- | Add to the global and column positions of a token.", - "-- The column position is only changed if the token is on", - "-- the same line as the given position.", - "incrGlobal :: Position -- ^ If the token is on the same line", - " -- as this position, update the column position.", - " -> Int -- ^ Number of characters to add to the position.", - " -> Token -> Token", - "incrGlobal (Pn _ l0 _) i (PT (Pn g l c) t) =", - " if l /= l0 then PT (Pn (g + i) l c) t", - " else PT (Pn (g + i) l (c + i)) t", - "incrGlobal _ _ p = error $ \"cannot add token at \" ++ show p", - "", - "-- | Create a symbol token.", - "sToken :: Position -> String -> Token", - "sToken p s = PT p (TS " ++ tokenTextPackParens tokenText "s" ++ " i)", - " where", - " i = case s of"] ++ - [ " " ++ show s ++ " -> " ++ show i - | (s, i) <- zip resws [1..] - ] ++ - [" _ -> error $ \"not a reserved word: \" ++ show s", - "", - "-- | Get the position of a token.", - "position :: Token -> Position", - "position t = case t of", - " PT p _ -> p", - " Err p -> p", - "", - "-- | Get the line number of a token.", - "line :: Token -> Int", - "line t = case position t of Pn _ l _ -> l", - "", - "-- | Get the column number of a token.", - "column :: Token -> Int", - "column t = case position t of Pn _ _ c -> c", - "", - "-- | Check if a token is one of the given symbols.", - "isTokenIn :: [String] -> Token -> Bool", - "isTokenIn ts t = case t of", - " PT _ (TS r _) | " ++ tokenTextUnpack tokenText "r" ++ " `elem` ts -> True", - " _ -> False", - "", - "-- | Check if a word is a layout start token.", - "isLayout :: Token -> Bool", - "isLayout = isTokenIn layoutWords", - "", - "-- | Check if a token is a layout stop token.", - "isStop :: Token -> Bool", - "isStop = isTokenIn layoutStopWords", - "", - "-- | Check if a token is the layout open token.", - "isLayoutOpen :: Token -> Bool", - "isLayoutOpen = isTokenIn [layoutOpen]", - "", - "-- | Check if a token is the layout close token.", - "isLayoutClose :: Token -> Bool", - "isLayoutClose = isTokenIn [layoutClose]", - "", - "-- | Get the number of characters in the token.", - "tokenLength :: Token -> Int", - "tokenLength t = length $ prToken t", +data LayoutDelimiters = LayoutDelimiters TokSymbol (Maybe TokSymbol) (Maybe TokSymbol) + deriving Show - "" +cf2Layout :: String -> String -> CF -> String +cf2Layout layName lexName cf = unlines $ concat + [ [ "-- Generated by the BNF Converter" + , "" + , "{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}" + , "" + , "{-# LANGUAGE LambdaCase #-}" + , "{-# LANGUAGE PatternGuards #-}" + , "{-# LANGUAGE OverloadedStrings #-}" + , "" + , "module " ++ layName ++ " where" + , "" + , "import Prelude" + , "import Data.Maybe ( fromMaybe, listToMaybe, mapMaybe )" + , "import qualified Data.List as List" + , "" + , "import " ++ lexName + , " ( Posn(..), Tok(..), Token(..), TokSymbol(..)" + , " , prToken, tokenLineCol, tokenPos, tokenPosn" + , " )" + , "" + , "-- local parameters" + , "" + , "data LayoutDelimiters" + , " = LayoutDelimiters" + , " { delimSep :: TokSymbol" + , " , delimOpen :: Maybe TokSymbol -- ^ Nothing for toplevel layout." + , " , delimClose :: Maybe TokSymbol -- ^ Nothing for toplevel layout." + , " }" + , "" + , "layoutWords :: [(TokSymbol, LayoutDelimiters)]" + , render $ prettyList 2 "layoutWords =" "[" "]" "," $ + for lay $ \ (kw, delims) -> + prettyList 0 empty "(" ")" "," $ + map text [ show kw, show delims ] + , "" + , "layoutStopWords :: [TokSymbol]" + , render $ prettyList 2 "layoutStopWords =" "[" "]" "," $ map (text . show) stop + , "" + , "-- layout separators" + , "" + , "layoutOpen, layoutClose, layoutSep :: [TokSymbol]" + , "layoutOpen = List.nub $ mapMaybe (delimOpen . snd) layoutWords" + , "layoutClose = List.nub $ mapMaybe (delimClose . snd) layoutWords" + , unwords $ concat + [ [ "layoutSep = List.nub $" ] + , whenJust top $ \ sep -> [ show sep, ":" ] + , [ "map (delimSep . snd) layoutWords" ] + ] + , "" + , "-- | Replace layout syntax with explicit layout tokens." + , "resolveLayout :: Bool -- ^ Whether to use top-level layout." + , " -> [Token] -> [Token]" + ] + , caseMaybe topDelim + -- No top-level layout + [ "resolveLayout _topLayout = res Nothing [Explicit]" + , " where" + ] + -- Can have top-level layout + (\ delim -> + [ "resolveLayout topLayout =" + , " res Nothing [if topLayout then Implicit topDelim Definitive 1 else Explicit]" + , " where" + , " topDelim :: LayoutDelimiters" + , " topDelim = " ++ show delim + ]) + , [ "" + , " res :: Maybe Token -- ^ The previous token, if any." + , " -> [Block] -- ^ A stack of layout blocks." + , " -> [Token] -> [Token]" + , "" + , " -- The stack should never be empty." + , " res _ [] ts = error $ \"Layout error: stack empty. Tokens: \" ++ show ts" + , "" + , " -- Handling explicit blocks:" + , " res _ st (t0 : ts)" + , " -- We found an open brace in the input," + , " -- put an explicit layout block on the stack." + , " -- This is done even if there was no layout word," + , " -- to keep opening and closing braces." + , " | isLayoutOpen t0" + , " = t0 : res (Just t0) (Explicit : st) ts" + , "" + , " -- If we encounter a closing brace, exit the first explicit layout block." + , " | isLayoutClose t0" + , " , let (imps, rest) = span isImplicit st" + , " , let st' = drop 1 rest" + , " = if null st'" + , " then error $ unwords" + , " [ \"Layout error: Found\", prToken t0, \"at\" , tokenPos [t0]" + , " , \"without an explicit layout block.\"" + , " ]" + , " else map (closingToken (tokenPosn t0)) imps ++ t0 : res (Just t0) st' ts" + , "" + , " -- Ending or confirming implicit layout blocks:" + , " res pt (b@(Implicit delim status col) : bs) (t0 : ts)" + , "" + , " -- End of implicit block by a layout stop word." + , " | isStop t0" + , " -- Exit the current block and all implicit blocks" + , " -- more indented than the current token." + , " , let (ebs, st') = span ((column t0 <) . indentation) bs" + , " -- Insert block-closers after the previous token." + , " = map (closingToken (afterPrev pt)) (b : ebs) ++ t0 : res (Just t0) st' ts" + , "" + , " -- End of an implicit layout block by dedentation." + , " | newLine pt t0" + , " , column t0 < col" + , " -- Insert a block closer after the previous token." + , " -- Repeat, with the current block removed from the stack." + , " , let c = closingToken (afterPrev pt) b" + , " = c : res (Just c) bs (t0 : ts)" + , "" + , " -- If we are on a newline, confirm the last tentative blocks." + , " | newLine pt t0, Tentative{} <- status" + , " = res pt (Implicit delim Definitive col : confirm col bs) (t0 : ts)" + , "" + , " -- Starting and processing implicit layout blocks:" + , " res pt st (t0 : ts)" + , " -- Start a new layout block if the first token is a layout word." + , " | Just delim@(LayoutDelimiters _ mopen _) <- isLayout t0" + , " = maybeInsertSeparator pt t0 st $" + , " case ts of" + , " -- Explicit layout, just move on. The next step" + , " -- will push an explicit layout block." + , " t1 : _ | isLayoutOpen t1 ->" + , " t0 : res (Just t0) st ts" + , " -- Otherwise, insert an open brace after the layout word" + , " _ ->" + , " t0 : b : res (Just b) (addImplicit delim (tokenPosn t0) pos st) ts" + , " where" + , " b = sToken (nextPos t0) $ fromMaybe undefined mopen" + , " -- At the end of the file, the start column does not matter." + , " -- So if there is no token t1 after t0, just use the position of t0." + , " pos = tokenPosn $ fromMaybe t0 $ listToMaybe ts" + , "" + , " -- Insert separator if necessary." + , " | otherwise" + , " = maybeInsertSeparator pt t0 st $" + , " t0 : res (Just t0) st ts" + , "" + , " -- At EOF: skip explicit blocks." + , " res (Just _) [Explicit] [] = []" + , " res (Just t) (Explicit : bs) [] = res (Just t) bs []" + , "" + , " -- If we are using top-level layout, insert a semicolon after" + , " -- the last token, if there isn't one already" + , " res (Just t) [Implicit (LayoutDelimiters sep _ _) _ _] []" + , " | isLayoutSep t = []" + , " | otherwise = [sToken (nextPos t) sep]" + , "" + , " -- At EOF in an implicit, non-top-level block: close the block" + , " res (Just t) (Implicit (LayoutDelimiters _ _ (Just close)) _ _ : bs) []" + , " = b : res (Just b) bs []" + , " where b = sToken (nextPos t) close" + , "" + , " -- This should only happen if the input is empty." + , " res Nothing _st []" + , " = []" + , "" + , " -- | Insert a 'layoutSep' if we are on a new line on the current" + , " -- implicit layout column." + , " maybeInsertSeparator" + , " :: Maybe Token -- ^ The previous token." + , " -> Token -- ^ The current token." + , " -> [Block] -- ^ The layout stack." + , " -> [Token] -- ^ The result token stream." + , " -> [Token] -- ^ Maybe prepended with a 'layoutSep'." + , " maybeInsertSeparator pt t0 = \\case" + , " Implicit (LayoutDelimiters sep _ _) _ n : _" + , " | newLine pt t0" + , " , column t0 == n" + , " , maybe False (not . isTokenIn (layoutSep ++ layoutOpen)) pt" + , " -- Insert a semicolon after the previous token" + , " -- unless we are the beginning of the file," + , " -- or the previous token is a semicolon or open brace." + , " -> (sToken (afterPrev pt) sep :)" + , " _ -> id" + , "" + , " closingToken :: Position -> Block -> Token" + , " closingToken pos = sToken pos . \\case" + , " Implicit (LayoutDelimiters _ _ (Just sy)) _ _ -> sy" + , "" + , "type Position = Posn" + , "type Line = Int" + , "type Column = Int" + , "" + , "-- | Entry of the layout stack." + , "data Block" + , " = Implicit LayoutDelimiters Status Column" + , " -- ^ An implicit layout block with its start column." + , " | Explicit" + , "" + , "-- | Get current indentation. 0 if we are in an explicit block." + , "indentation :: Block -> Column" + , "indentation = \\case" + , " Implicit _ _ n -> n" + , " Explicit -> 0" + , "" + , "-- | Check if s block is implicit." + , "isImplicit :: Block -> Bool" + , "isImplicit = \\case" + , " Implicit{} -> True" + , " Explicit{} -> False" + , "" + , "data Status" + , " = Tentative -- ^ A layout column that has not been confirmed by a line break" + , " | Definitive -- ^ A layout column that has been confirmed by a line break." + , "" + , "-- | Add a new implicit layout block." + , "addImplicit" + , " :: LayoutDelimiters -- ^ Delimiters of the new block." + , " -> Position -- ^ Position of the layout keyword." + , " -> Position -- ^ Position of the token following the layout keword." + , " -> [Block]" + , " -> [Block]" + , "addImplicit delim (Pn _ l0 _) (Pn _ l1 c1) st" + , " -- Case: layout keyword was at the end of the line:" + , " -- New implicit block is definitive." + , " | l1 > l0 = Implicit delim Definitive (col st') : st'" + , " -- Case: staying on the same line:" + , " -- New implicit block is tentative." + , " | otherwise = Implicit delim Tentative (col st) : st" + , " where" + , " st' = confirm c1 st" + , " col bs = max c1 $ 1 + definiteIndentation bs" + , " -- The column of the next token determines the starting column" + , " -- of the implicit layout block." + , " -- However, the next block needs to be strictly more indented" + , " -- than the previous block." + , "" + , " -- | Get the current confirmed indentation level." + , " definiteIndentation :: [Block] -> Int" + , " definiteIndentation bs =" + , " case dropWhile isTentative bs of" + , " Implicit _ Definitive n : _ -> n" + , " _ -> 0 -- 0 enables a first unindented block, see 194_layout/good05.in" + , "" + , " isTentative :: Block -> Bool" + , " isTentative = \\case" + , " Implicit _ Tentative _ -> True" + , " _ -> False" + , "" + , "-- | Confirm tentative blocks that are not more indented than @col@." + , "confirm :: Column -> [Block] -> [Block]" + , "confirm c0 = loop" + , " where" + , " loop = \\case" + , " Implicit delim Tentative c : bs" + , " | c <= c0 -> Implicit delim Definitive c : loop bs" + , " bs -> bs" + , "" + , "-- | Get the position immediately to the right of the given token." + , "-- If no token is given, gets the first position in the file." + , "afterPrev :: Maybe Token -> Position" + , "afterPrev = maybe (Pn 0 1 1) nextPos" + , "" + , "-- | Get the position immediately to the right of the given token." + , "nextPos :: Token -> Position" + , "nextPos t = Pn (g + s) l (c + s + 1)" + , " where" + , " Pn g l c = tokenPosn t" + , " s = tokenLength t" + , "" + , "-- | Get the number of characters in the token." + , "tokenLength :: Token -> Int" + , "tokenLength = length . prToken" + , "" + , "-- | Create a position symbol token." + , "sToken :: Position -> TokSymbol -> Token" + , "sToken p t = PT p $ TK t" + , "" + , "-- | Get the line number of a token." + , "line :: Token -> Line" + , "line = fst . tokenLineCol" + , "" + , "-- | Get the column number of a token." + , "column :: Token -> Column" + , "column = snd . tokenLineCol" + , "" + , "-- | Is the following token on a new line?" + , "newLine :: Maybe Token -> Token -> Bool" + , "newLine pt t0 = maybe True ((line t0 >) . line) pt" + , "" + , "-- | Check if a word is a layout start token." + , "isLayout :: Token -> Maybe LayoutDelimiters" + , "isLayout = \\case" + , " PT _ (TK t) -> lookup t layoutWords" + , " _ -> Nothing" + , "" + , "-- | Check if a token is one of the given symbols." + , "isTokenIn :: [TokSymbol] -> Token -> Bool" + , "isTokenIn ts = \\case" + , " PT _ (TK t) -> t `elem` ts" + , " _ -> False" + , "" + , "-- | Check if a token is a layout stop token." + , "isStop :: Token -> Bool" + , "isStop = isTokenIn layoutStopWords" + , "" + , "-- | Check if a token is the layout open token." + , "isLayoutOpen :: Token -> Bool" + , "isLayoutOpen = isTokenIn layoutOpen" + , "" + , "-- | Check if a token is the layout separator token." + , "isLayoutSep :: Token -> Bool" + , "isLayoutSep = isTokenIn layoutSep" + , "" + , "-- | Check if a token is the layout close token." + , "isLayoutClose :: Token -> Bool" + , "isLayoutClose = isTokenIn layoutClose" + ] ] where - resws = sort $ reservedWords cf ++ cfgSymbols cf - (top,lay,stop) = layoutPragmas cf + (top0, lay0, stop0) = layoutPragmas cf + top = fmap mkTokSymbol top0 + topDelim = fmap (\ sep -> LayoutDelimiters sep Nothing Nothing) top + lay = for lay0 $ \ (kw, Delimiters sep open close) -> + ( mkTokSymbol kw + , LayoutDelimiters (mkTokSymbol sep) (Just $ mkTokSymbol open) (Just $ mkTokSymbol close) + ) + stop = map mkTokSymbol stop0 + mkTokSymbol :: String -> TokSymbol + mkTokSymbol x = TokSymbol x n + where + n = fromMaybe (-1) $ lookup x tokens + tokens = cfTokens cf diff --git a/src/BNFC/Backend/Haskell/CFtoPrinter.hs b/src/BNFC/Backend/Haskell/CFtoPrinter.hs --- a/src/BNFC/Backend/Haskell/CFtoPrinter.hs +++ b/src/BNFC/Backend/Haskell/CFtoPrinter.hs @@ -38,15 +38,15 @@ -> String -- ^ Name of created Haskell module. -> AbsMod -- ^ Name of Haskell module for abstract syntax. -> CF -- ^ Grammar. - -> String -cf2Printer tokenText functor useGadt name absMod cf = unlines $ concat $ - -- Each of the following list entries is itself a list of lines - [ prologue tokenText useGadt name [ absMod | importAbsMod ] + -> Doc +cf2Printer tokenText functor useGadt name absMod cf = vcat $ concat $ + -- Each of the following list entries is itself a list of Docs + [ prologue tokenText useGadt name [ absMod | importAbsMod ] cf , integerRule absMod cf , doubleRule absMod cf - , if hasIdent cf then identRule absMod tokenText cf else [] - ] ++ [ ownPrintRule absMod tokenText cf own | (own,_) <- tokenPragmas cf ] ++ - [ rules absMod functor cf + , when (hasIdent cf) $ identRule absMod tokenText cf + , concat [ ownPrintRule absMod tokenText cf own | (own,_) <- tokenPragmas cf ] + , rules absMod functor cf ] where importAbsMod = not (null $ cf2data cf) || not (null $ specialCats cf) @@ -54,10 +54,10 @@ -- | Lowercase Haskell identifiers imported from ''Prelude''. lowerCaseImports :: [String] lowerCaseImports = - [ "all", "dropWhile", "elem", "foldr", "id", "map", "null", "replicate", "shows", "span" ] + [ "all", "elem", "foldr", "id", "map", "null", "replicate", "shows", "span" ] -prologue :: TokenText -> Bool -> String -> [AbsMod] -> [String] -prologue tokenText useGadt name absMod = concat +prologue :: TokenText -> Bool -> String -> [AbsMod] -> CF -> [Doc] +prologue tokenText useGadt name absMod cf = map text $ concat [ [ "{-# LANGUAGE CPP #-}" , "{-# LANGUAGE FlexibleInstances #-}" , "{-# LANGUAGE LambdaCase #-}" @@ -86,7 +86,7 @@ , "import Data.Char ( Char, isSpace )" ] , fmap ("import qualified " ++) absMod -- At most 1. (Unnecessary if Abs module is empty.) - , tokenTextImport tokenText + , when (hasTextualTokens cf) $ tokenTextImport tokenText , [ "" , "-- | The top-level printing method." , "" @@ -99,19 +99,48 @@ , "doc = (:)" , "" , "render :: Doc -> String" - , "render d = rend 0 (map ($ \"\") $ d []) \"\" where" - , " rend i = \\case" - , " \"[\" :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" - , " [\";\"] -> showChar ';'" - , " \";\" :ts -> showChar ';' . new i . rend i ts" - , " t : ts@(p:_) | closingOrPunctuation p -> showString t . rend i ts" - , " t :ts -> space t . rend i ts" - , " _ -> id" - , " new i = showChar '\\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace" + , "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" @@ -145,16 +174,26 @@ , "" , "class Print a where" , " prt :: Int -> a -> Doc" - , " prtList :: Int -> [a] -> Doc" - , " prtList i = concatD . map (prt i)" , "" , "instance {-# OVERLAPPABLE #-} Print a => Print [a] where" - , " prt = prtList" + , " prt i = concatD . map (prt i)" , "" , "instance Print Char where" - , " prt _ s = doc (showChar '\\'' . mkEsc '\\'' s . showChar '\\'')" - , " prtList _ s = doc (showChar '\"' . concatS (map (mkEsc '\"') s) . showChar '\"')" + , " prt _ c = doc (showChar '\\'' . mkEsc '\\'' c . showChar '\\'')" , "" + ] + , if haveListChar then + [ "-- | No @instance 'Print' String@ because it would clash with the instance" + , "-- for @[Char]@." + ] + else + [ "instance Print String where" + , " prt _ = printString" + , "" + ] + , [ "printString :: String -> Doc" + , "printString s = doc (showChar '\"' . concatS (map (mkEsc '\"') s) . showChar '\"')" + , "" , "mkEsc :: Char -> Char -> ShowS" , "mkEsc q = \\case" , " s | s == q -> showChar '\\\\' . showChar s" @@ -168,21 +207,22 @@ , "" ] ] + where + haveListChar = not $ null $ rulesForCat cf $ ListCat $ TokenCat "Char" -- | Printing instance for @Integer@, and possibly @[Integer]@. -integerRule :: AbsMod -> CF -> [String] +integerRule :: AbsMod -> CF -> [Doc] integerRule absMod cf = showsPrintRule absMod cf $ TokenCat catInteger -- | Printing instance for @Double@, and possibly @[Double]@. -doubleRule :: AbsMod -> CF -> [String] +doubleRule :: AbsMod -> CF -> [Doc] doubleRule absMod cf = showsPrintRule absMod cf $ TokenCat catDouble -showsPrintRule :: AbsMod -> CF -> Cat -> [String] +showsPrintRule :: AbsMod -> CF -> Cat -> [Doc] showsPrintRule absMod cf t = - [ unwords [ "instance Print" , qualifiedCat absMod t , "where" ] + [ hsep [ "instance Print" , text (qualifiedCat absMod t) , "where" ] , " prt _ x = doc (shows x)" - ] ++ ifList cf t ++ - [ "" + , "" ] -- | Print category (data type name) qualified if user-defined. @@ -198,62 +238,69 @@ where unqualified = catToStr t qualified = qualify absMod unqualified - impossible = error $ "impossible in Backend.Haskell.CFtoPrinter.qualifiedCat: " ++ show t + impossible = error $ "impossible in Backend.Haskell.CFtoPrinter.qualifiedCat: " ++ catToStr t qualify :: AbsMod -> String -> String qualify absMod s = concat [ absMod, "." , s ] -- | Printing instance for @Ident@, and possibly @[Ident]@. -identRule :: AbsMod -> TokenText -> CF -> [String] +identRule :: AbsMod -> TokenText -> CF -> [Doc] identRule absMod tokenText cf = ownPrintRule absMod tokenText cf catIdent -- | Printing identifiers and terminals. -ownPrintRule :: AbsMod -> TokenText -> CF -> TokenCat -> [String] -ownPrintRule absMod tokenText cf own = concat - [ [ "instance Print " ++ q ++ " where" - , " prt _ (" ++ q ++ posn ++ ") = doc $ showString " ++ tokenTextUnpack tokenText "i" - ] - , ifList cf (TokenCat own) - , [ "" - ] +ownPrintRule :: AbsMod -> TokenText -> CF -> TokenCat -> [Doc] +ownPrintRule absMod tokenText cf own = + [ "instance Print" <+> q <+> "where" + , " prt _ (" <> q <+> posn <> ") = doc $ showString" <+> text (tokenTextUnpack tokenText "i") ] where - q = qualifiedCat absMod $ TokenCat own - posn = if isPositionCat cf own then " (_,i)" else " i" + q = text $ qualifiedCat absMod $ TokenCat own + posn = if isPositionCat cf own then "(_,i)" else "i" -- | Printing rules for the AST nodes. -rules :: AbsMod -> Bool -> CF -> [String] +rules :: AbsMod -> Bool -> CF -> [Doc] rules absMod functor cf = do - (cat, xs :: [(Fun, [Cat])]) <- cf2dataLists cf - [ render (case_fun absMod functor cat (map (toArgs cat) xs)) ] ++ ifList cf cat ++ [ "" ] + (cat, xs :: [ (Fun, [Cat]) ]) <- cf2dataLists cf + concat $ + [ case_fun absMod functor cf cat $ map (toArgs cat) xs + , [ "" ] + ] where toArgs :: Cat -> (Fun, [Cat]) -> Rule toArgs cat (cons, _) = - case filter (\ (Rule f c _rhs _internal) -> cons == funName f && cat == normCat (wpThing c)) (cfgRules cf) + case filter (\ (Rule f c _rhs _internal) -> + cons == funName f && cat == normCat (wpThing c)) + (cfgRules cf) of (r : _) -> r -- 2018-01-14: Currently, there can be overlapping rules like -- Foo. Bar ::= "foo" ; -- Foo. Bar ::= "bar" ; -- Of course, this will generate an arbitary printer for @Foo@. - [] -> error $ "CFToPrinter.rules: no rhs found for: " ++ cons ++ ". " ++ show cat ++ " ::= ?" + [] -> error $ "CFToPrinter.rules: no rhs found for: " ++ cons ++ ". " ++ catToStr cat ++ " ::= ?" -- | --- >>> case_fun "Abs" False (Cat "A") [ (npRule "AA" (Cat "AB") [Right "xxx"]) Parsable ] +-- >>> vcat $ case_fun "Abs" False undefined (Cat "A") [ (npRule "AA" (Cat "AB") [Right "xxx"]) Parsable ] -- instance Print Abs.A where -- prt i = \case -- Abs.AA -> prPrec i 0 (concatD [doc (showString "xxx")]) -case_fun :: AbsMod -> Bool -> Cat -> [Rule] -> Doc -case_fun absMod functor cat xs = - -- trace ("case_fun: cat = " ++ show cat) $ - -- trace ("case_fun: xs = " ++ show xs ) $ - vcat - [ "instance Print" <+> type_ <+> "where" - , nest 2 $ if isList cat then "prt = prtList" else vcat +case_fun :: AbsMod -> Bool -> CF -> Cat -> [Rule] -> [Doc] +case_fun absMod functor cf cat rules = + -- trace ("case_fun: cat = " ++ catToStr cat) $ + -- trace ("case_fun: rules = " ++ show rules ) $ + [ "instance Print" <+> type_ <+> "where" + , nest 2 $ vcat $ + + -- Special printing of lists (precedence changes concrete syntax!) + if isList cat then + map mkPrtListCase $ List.sortBy compareRules $ rulesForNormalizedCat cf cat + + -- Ordinary category + else [ "prt i = \\case" - , nest 2 $ vcat (map (mkPrintCase absMod functor) xs) + , nest 2 $ vcat $ map (mkPrintCase absMod functor) rules ] - ] + ] where type_ | functor = case cat of @@ -296,6 +343,7 @@ where pat :: Doc pat + | isNilFun f = text "[]" | isOneFun f = text "[" <+> head variables <+> "]" | isConsFun f = hsep $ List.intersperse (text ":") variables | otherwise = text (qualify absMod $ funName f) <+> (if functor then "_" else empty) <+> hsep variables @@ -317,45 +365,33 @@ var (TokenCat "String") = "str" var (TokenCat "Char") = "c" var (TokenCat "Double") = "d" - var xs = map toLower $ show xs - -ifList :: CF -> Cat -> [String] -ifList cf cat = - -- trace ("ifList cf = " ++ show cf ) $ - -- trace ("ifList cat = " ++ show cat ) $ - -- trace ("ifList rules = " ++ show rules) $ - -- trace ("ifList rulesForCat' cf (ListCat cat) = " ++ show (rulesForCat' cf (ListCat cat))) $ - -- trace "" $ - map (render . nest 2) cases - where - rules = List.sortBy compareRules $ rulesForNormalizedCat cf (ListCat cat) - cases = [ mkPrtListCase r | r <- rules ] + var xs = map toLower $ catToStr xs -- | Pattern match on the list constructor and the coercion level -- -- >>> mkPrtListCase (npRule "[]" (ListCat (Cat "Foo")) [] Parsable) --- prtList _ [] = concatD [] +-- prt _ [] = concatD [] -- -- >>> mkPrtListCase (npRule "(:[])" (ListCat (Cat "Foo")) [Left (Cat "FOO")] Parsable) --- prtList _ [x] = concatD [prt 0 x] +-- prt _ [x] = concatD [prt 0 x] -- -- >>> mkPrtListCase (npRule "(:)" (ListCat (Cat "Foo")) [Left (Cat "Foo"), Left (ListCat (Cat "Foo"))] Parsable) --- prtList _ (x:xs) = concatD [prt 0 x, prt 0 xs] +-- prt _ (x:xs) = concatD [prt 0 x, prt 0 xs] -- -- >>> mkPrtListCase (npRule "[]" (ListCat (CoercCat "Foo" 2)) [] Parsable) --- prtList 2 [] = concatD [] +-- prt 2 [] = concatD [] -- -- >>> mkPrtListCase (npRule "(:[])" (ListCat (CoercCat "Foo" 2)) [Left (CoercCat "Foo" 2)] Parsable) --- prtList 2 [x] = concatD [prt 2 x] +-- prt 2 [x] = concatD [prt 2 x] -- -- >>> mkPrtListCase (npRule "(:)" (ListCat (CoercCat "Foo" 2)) [Left (CoercCat "Foo" 2), Left (ListCat (CoercCat "Foo" 2))] Parsable) --- prtList 2 (x:xs) = concatD [prt 2 x, prt 2 xs] +-- prt 2 (x:xs) = concatD [prt 2 x, prt 2 xs] -- mkPrtListCase :: Rule -> Doc mkPrtListCase (Rule f (WithPosition _ (ListCat c)) rhs _internal) - | isNilFun f = "prtList" <+> precPattern <+> "[]" <+> "=" <+> body - | isOneFun f = "prtList" <+> precPattern <+> "[x]" <+> "=" <+> body - | isConsFun f = "prtList" <+> precPattern <+> "(x:xs)" <+> "=" <+> body + | isNilFun f = "prt" <+> precPattern <+> "[]" <+> "=" <+> body + | isOneFun f = "prt" <+> precPattern <+> "[x]" <+> "=" <+> body + | isConsFun f = "prt" <+> precPattern <+> "(x:xs)" <+> "=" <+> body | otherwise = empty -- (++) constructor where precPattern = case precCat c of 0 -> "_" ; p -> integer p @@ -371,7 +407,7 @@ -- -- - [] < [_] < _:_ -- --- This is desiged to correctly order the rules in the prtList function so that +-- This is desiged to correctly order the rules in the prt function for lists so that -- the pattern matching works as expectd. -- -- >>> compareRules (npRule "[]" (ListCat (CoercCat "Foo" 3)) [] Parsable) (npRule "[]" (ListCat (CoercCat "Foo" 1)) [] Parsable) @@ -424,4 +460,5 @@ mk (arg:args) (Left c : items) = (prt c <+> text arg) : mk args items mk args (Right s : items) = ("doc (showString" <+> text (show s) <> ")") : mk args items mk _ _ = [] + prt (TokenCat "String") = "printString" prt c = "prt" <+> integer (precCat c) diff --git a/src/BNFC/Backend/Haskell/CFtoTemplate.hs b/src/BNFC/Backend/Haskell/CFtoTemplate.hs --- a/src/BNFC/Backend/Haskell/CFtoTemplate.hs +++ b/src/BNFC/Backend/Haskell/CFtoTemplate.hs @@ -72,7 +72,7 @@ | otherwise = empty type_ = qualify $ cat' <> iffunctor "' a" fname = "trans" <> cat' - cat' = text (show cat) + cat' = pretty cat mkOne (cons, args) = let ns = catvars [render fname] args -- names False (map (checkRes .var) args) 1 in qualify (text cons) <+> iffunctor "_" <+> hsep ns <+> "-> failure x" diff --git a/src/BNFC/Backend/Haskell/Utils.hs b/src/BNFC/Backend/Haskell/Utils.hs --- a/src/BNFC/Backend/Haskell/Utils.hs +++ b/src/BNFC/Backend/Haskell/Utils.hs @@ -247,4 +247,4 @@ catvars rs = map text . mkNames (rs ++ hsReservedWords) LowerCase . map var where var (ListCat c) = var c ++ "s" - var xs = show xs + var c = catToStr c diff --git a/src/BNFC/Backend/HaskellGADT.hs b/src/BNFC/Backend/HaskellGADT.hs --- a/src/BNFC/Backend/HaskellGADT.hs +++ b/src/BNFC/Backend/HaskellGADT.hs @@ -49,10 +49,10 @@ mkfile (templateFile opts) $ cf2Template (templateFileM opts) absMod cf mkfile (printerFile opts) $ cf2Printer StringToken False True prMod absMod cf when (hasLayout cf) $ mkfile (layoutFile opts) $ - cf2Layout (tokenText opts) layMod lexMod cf + cf2Layout layMod lexMod cf mkfile (tFile opts) $ Haskell.testfile opts cf mkfile (errFile opts) $ mkErrM errMod - Makefile.mkMakefile opts $ Haskell.makefile opts + Makefile.mkMakefile opts $ Haskell.makefile opts cf case xml opts of 2 -> makeXML opts True cf 1 -> makeXML opts False cf diff --git a/src/BNFC/Backend/HaskellGADT/CFtoAbstractGADT.hs b/src/BNFC/Backend/HaskellGADT/CFtoAbstractGADT.hs --- a/src/BNFC/Backend/HaskellGADT/CFtoAbstractGADT.hs +++ b/src/BNFC/Backend/HaskellGADT/CFtoAbstractGADT.hs @@ -20,23 +20,32 @@ cf2Abstract :: TokenText -> String -> CF -> String -> String cf2Abstract tokenText name cf composOpMod = unlines $ concat $ - [ [ "{-# LANGUAGE GADTs, KindSignatures, DataKinds #-}" - , "{-# LANGUAGE EmptyCase #-}" - , "{-# LANGUAGE LambdaCase #-}" + [ [ "-- Haskell module generated by the BNF converter" + , "-- For GHC version 7.10 or higher" , "" + , "{-# LANGUAGE GADTs, KindSignatures, DataKinds #-}" + ] + , [ "{-# LANGUAGE EmptyCase #-}" | emptyTree ] + , [ "{-# LANGUAGE LambdaCase #-}" + , "" + , "{-# OPTIONS_GHC -fno-warn-unused-binds #-}" + -- unused-local-binds would be sufficient, but parses only from GHC 8.0 , "{-# OPTIONS_GHC -fno-warn-unused-imports #-}" + , "{-# OPTIONS_GHC -fno-warn-unused-matches #-}" + , "{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}" + -- defects of coverage checker, e.g. in 8.2.2, may lead to warning + -- about exceeded iterations for pattern match checker , "{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}" , "" , "module" +++ name +++ "(" ++ List.intercalate ", " exports ++ ")" +++ "where" , "" , "import Prelude (" ++ typeImports ++ ", (.), (>), (&&), (==))" , "import qualified Prelude as P" - , "" - , "import " ++ composOpMod + -- , "import qualified Data.Kind as K (Type)" ] , tokenTextImport tokenText , [ "" - , "-- Haskell module generated by the BNF converter" + , "import " ++ composOpMod , "" ] , prDummyTypes cf @@ -54,8 +63,9 @@ , map ((++ "\n") . show) $ definedRules False cf ] where + emptyTree = null (cf2cons cf) exports = concat $ - [ [ "Tree(..)" ] + [ [ if emptyTree then "Tree" else "Tree(..)" ] , getTreeCats cf , map mkDefName $ getDefinitions cf , [ "johnMajorEq" @@ -69,10 +79,10 @@ ] getTreeCats :: CF -> [String] -getTreeCats cf = List.nub $ map show $ filter (not . isList) $ map consCat $ cf2cons cf +getTreeCats cf = List.nub $ map catToStr $ filter (not . isList) $ map consCat $ cf2cons cf getDefinitions :: CF -> [String] -getDefinitions cf = [ funName f | FunDef f _ _ <- cfgPragmas cf ] +getDefinitions = map (funName . defName) . definitions prDummyTypes :: CF -> [String] prDummyTypes cf = prDummyData : map prDummyType cats @@ -97,13 +107,13 @@ prTreeType :: TokenText -> CF -> [String] prTreeType tokenText cf = - "data Tree :: Tag -> * where" : map ((" " ++) . prTreeCons) (cf2cons cf) + "data Tree (a :: Tag) where" : map ((" " ++) . prTreeCons) (cf2cons cf) where prTreeCons c | TokenCat tok <- cat, isPositionCat cf tok = fun +++ ":: ((Int,Int),"++ tokenTextType tokenText ++") -> Tree" +++ mkRealType tok | otherwise = - fun +++ "::" +++ concat [show c +++ "-> " | (c,_) <- consVars c] ++ "Tree" +++ mkRealType (show cat) + fun +++ "::" +++ concat [catToStr c +++ "-> " | (c,_) <- consVars c] ++ "Tree" +++ mkRealType (catToStr cat) where (cat,fun) = (consCat c, consFun c) @@ -126,11 +136,11 @@ prShow :: CF -> [String] prShow cf = ["instance P.Show (Tree c) where", - " showsPrec n t = case t of"] + " showsPrec n = \\case"] ++ map ((" "++) .prShowCons) cs - ++ [" where", - " opar = if n > 0 then P.showChar '(' else P.id", - " cpar = if n > 0 then P.showChar ')' else P.id"] + ++ [" where", + " opar = if n > 0 then P.showChar '(' else P.id", + " cpar = if n > 0 then P.showChar ')' else P.id"] where cs = cf2cons cf prShowCons c | null vars = fun +++ "->" +++ "P.showString" +++ show fun diff --git a/src/BNFC/Backend/HaskellGADT/CFtoTemplateGADT.hs b/src/BNFC/Backend/HaskellGADT/CFtoTemplateGADT.hs --- a/src/BNFC/Backend/HaskellGADT/CFtoTemplateGADT.hs +++ b/src/BNFC/Backend/HaskellGADT/CFtoTemplateGADT.hs @@ -46,11 +46,13 @@ where prCatTrans :: Cat -> [Constructor] -> [String] prCatTrans cat cs = concat - [ [ "trans" ++ show cat +++ "::" +++ qualify (show cat) +++ "-> Result" - , "trans" ++ show cat +++ "t = case t of" + [ [ "trans" ++ s +++ "::" +++ qualify s +++ "-> Result" + , "trans" ++ s +++ "t = case t of" ] , map prConsCase cs ] + where + s = catToStr cat prConsCase :: Constructor -> String prConsCase c = diff --git a/src/BNFC/Backend/Java.hs b/src/BNFC/Backend/Java.hs --- a/src/BNFC/Backend/Java.hs +++ b/src/BNFC/Backend/Java.hs @@ -25,7 +25,7 @@ import Prelude hiding ((<>)) -import System.FilePath (pathSeparator, isPathSeparator) +import System.FilePath ((), (<.>), pathSeparator, isPathSeparator) import Data.Foldable (toList) import Data.List ( intersperse ) @@ -66,7 +66,7 @@ packageAbsyn = packageBase +.+ "Absyn" dirBase = pkgToDir packageBase dirAbsyn = pkgToDir packageAbsyn - javaex str = dirBase ++ str +.+ "java" + javaex str = dirBase str <.> "java" bnfcfiles = bnfcVisitorsAndTests packageBase @@ -85,12 +85,9 @@ makebnfcfile x = mkfile (javaex (fst $ x bnfcfiles)) (snd $ x bnfcfiles) - let absynFiles = remDups $ cf2JavaAbs packageBase packageAbsyn cf rp - absynBaseNames = map fst absynFiles - absynFileNames = map (dirAbsyn ++) absynBaseNames - let writeAbsyn (filename, contents) = - mkfile (dirAbsyn ++ filename ++ ".java") contents - mapM_ writeAbsyn absynFiles + let absynFiles = remDups $ cf2JavaAbs dirAbsyn packageBase packageAbsyn cf rp + absynFileNames = map fst absynFiles + mapM_ (\ (n, s) -> mkfile (n <.> "java") s) absynFiles makebnfcfile bprettyprinter makebnfcfile bskel makebnfcfile bcompos @@ -100,16 +97,16 @@ makebnfcfile btest let (lex, env) = lexfun packageBase cf -- Where the lexer file is created. lex is the content! - mkfile (dirBase ++ inputfile lexmake ) lex + mkfile (dirBase inputfile lexmake ) lex liftIO $ putStrLn $ " (Tested with" +++ toolname lexmake +++ toolversion lexmake ++ ")" -- where the parser file is created. - mkfile (dirBase ++ inputfile parmake) + mkfile (dirBase inputfile parmake) $ parsefun packageBase packageAbsyn cf rp env liftIO $ putStrLn $ if supportsEntryPoints parmake then "(Parser created for all categories)" - else " (Parser created only for category " ++ show (firstEntry cf) ++ ")" + else " (Parser created only for category " ++ prettyShow (firstEntry cf) ++ ")" liftIO $ putStrLn $ " (Tested with" +++ toolname parmake +++ toolversion parmake ++ ")" Makefile.mkMakefile options $ @@ -120,7 +117,7 @@ Just {} -> remDups as Nothing -> (a, b) : remDups as pkgToDir :: String -> FilePath - pkgToDir s = replace '.' pathSeparator s ++ [pathSeparator] + pkgToDir = replace '.' pathSeparator parselexspec = parserLexerSelector lang javaLexerParser rp lexfun = cf2lex $ lexer parselexspec @@ -152,41 +149,41 @@ ]++ [-- running the lexergen: output of lexer -> input of lexer : calls lexer let ff = filename lexmake -- name of input file without extension - dirBaseff = dirBase ++ ff -- prepend directory - inp = dirBase ++ inputfile lexmake in - Makefile.mkRule (dirBaseff +.+ "java") [ inp ] + dirBaseff = dirBase ff -- prepend directory + inp = dirBase inputfile lexmake in + Makefile.mkRule (dirBaseff <.> "java") [ inp ] [ "${LEXER} ${LEXER_FLAGS} "++ inp ] -- running the parsergen, these there are its outputs -- output of parser -> input of parser : calls parser - , let inp = dirBase ++ inputfile parmake in - Makefile.mkRule (unwords (map (dirBase++) (dotJava $ results parmake))) + , let inp = dirBase inputfile parmake in + Makefile.mkRule (unwords (map (dirBase ) (dotJava $ results parmake))) [ inp ] $ ("${PARSER} ${PARSER_FLAGS} " ++ inp) : - ["mv " ++ unwords (dotJava $ results parmake) +++ dirBase + ["mv " ++ unwords (dotJava $ results parmake) +++ dirBase ++ [pathSeparator] | moveresults parmake] -- Class of the output of lexer generator wants java of : -- output of lexer and parser generator - , let lexerOutClass = dirBase ++ filename lexmake +.+ "class" - outname x = dirBase ++ x +.+ "java" + , let lexerOutClass = dirBase filename lexmake <.> "class" + outname x = dirBase x <.> "java" deps = map outname (results lexmake ++ results parmake) in Makefile.mkRule lexerOutClass deps [] ]++ reverse [Makefile.mkRule tar dep [] | (tar,dep) <- partialParserGoals dirBase (results parmake)] - ++[ Makefile.mkRule (dirBase ++ "PrettyPrinter.class") - [ dirBase ++ "PrettyPrinter.java" ] [] + ++[ Makefile.mkRule (dirBase "PrettyPrinter.class") + [ dirBase "PrettyPrinter.java" ] [] -- Removes all the class files created anywhere - , Makefile.mkRule "clean" [] [ "rm -f " ++ dirAbsyn ++ "*.class" ++ " " - ++ dirBase ++ "*.class" ] + , Makefile.mkRule "clean" [] [ "rm -f " ++ dirAbsyn "*.class" ++ " " + ++ dirBase "*.class" ] -- Remains the same , Makefile.mkRule "distclean" [ "vclean" ] [] -- removes everything , Makefile.mkRule "vclean" [] [ " rm -f " ++ absynJavaSrc ++ " " ++ absynJavaClass - , " rm -f " ++ dirAbsyn ++ "*.class" + , " rm -f " ++ dirAbsyn "*.class" , " rmdir " ++ dirAbsyn - , " rm -f " ++ unwords (map (dirBase ++) $ + , " rm -f " ++ unwords (map (dirBase ) $ [ inputfile lexmake , inputfile parmake ] @@ -215,7 +212,7 @@ lexmake = makelexerdetails (lexer jlexpar) absynJavaSrc = unwords (dotJava absynFileNames) absynJavaClass = unwords (dotClass absynFileNames) - classes = prependPath dirBase lst + classes = map (dirBase ) lst lst = dotClass (results lexmake) ++ [ "PrettyPrinter.class", "Test.class" , "VisitSkel.class" , "ComposVisitor.class", "AbstractVisitor.class" @@ -479,9 +476,8 @@ antlrmakedetails :: String -> MakeFileDetails antlrmakedetails l = MakeDetails { executable = runJava "org.antlr.v4.Tool" - , flags = \x -> unwords $ - let path = take (length x - 1) x - pointed = map cnv path + , flags = \ path -> unwords $ + let pointed = map cnv path cnv y = if isPathSeparator y then '.' else y @@ -502,13 +498,9 @@ , moveresults = False } -prependPath , appendExtension :: String -> [String] -> [String] -prependPath s fi = [ s ++ x | x <- fi ] -appendExtension s fi = [ x +.+ s | x <- fi ] - -dotJava,dotClass :: [String] -> [String] -dotJava = appendExtension "java" -dotClass = appendExtension "class" +dotJava, dotClass :: [String] -> [String] +dotJava = map (<.> "java") +dotClass = map (<.> "class") type CFToJava = String -> String -> CF -> String @@ -540,16 +532,16 @@ } where app x = x pbase pabsyn cf -inputfile x = filename x ++ case fileextension x of - "" -> "" - a -> '.':a +inputfile x + | null (fileextension x) = filename x + | otherwise = filename x <.> fileextension x -- | constructs the rules regarding the parser in the makefile partialParserGoals :: String -> [String] -> [(String, [String])] partialParserGoals _ [] = [] -partialParserGoals dbas (x:rest) = - (dbas ++ x +.+ "class", map (\ y -> dbas ++ y +.+ "java") (x:rest)) - : partialParserGoals dbas rest +partialParserGoals dirBase (x:rest) = + (dirBase x <.> "class", map (\ y -> dirBase y <.> "java") (x:rest)) + : partialParserGoals dirBase rest -- | Creates the Test.java class. javaTest :: JavaTestParams -> TestClass diff --git a/src/BNFC/Backend/Java/CFtoAntlr4Parser.hs b/src/BNFC/Backend/Java/CFtoAntlr4Parser.hs --- a/src/BNFC/Backend/Java/CFtoAntlr4Parser.hs +++ b/src/BNFC/Backend/Java/CFtoAntlr4Parser.hs @@ -25,7 +25,6 @@ import BNFC.Backend.Java.Utils import BNFC.Backend.Common.NamedVariables -import BNFC.Backend.Java.CFtoCup15 ( definedRules ) -- Type declarations @@ -51,10 +50,6 @@ cf2AntlrParse packageBase packageAbsyn cf _ env = unlines $ concat [ [ header , tokens - , "@members {" - ] - , map (" " ++) $ definedRules packageAbsyn cf - , [ "}" , "" -- Generate start rules [#272] -- _X returns [ dX result ] : x=X EOF { $result = $x.result; } @@ -131,11 +126,12 @@ | isConsFun f = "$result = " ++ p_2 ++ "; " ++ "$result." ++ add ++ "(" ++ p_1 ++ ");" | isCoercion f = "$result = " ++ p_1 ++ ";" - | isDefinedRule f = "$result = " ++ funName f ++ "_" + | isDefinedRule f = "$result = " ++ packageAbsyn ++ "Def." ++ sanitize (funName f) ++ "(" ++ intercalate "," (map resultvalue ms) ++ ");" | otherwise = "$result = new " ++ c ++ "(" ++ intercalate "," (map resultvalue ms) ++ ");" where + sanitize = getRuleName c = packageAbsyn ++ "." ++ if isNilFun f || isOneFun f || isConsFun f then identCat (normCat nt) else funName f diff --git a/src/BNFC/Backend/Java/CFtoCup15.hs b/src/BNFC/Backend/Java/CFtoCup15.hs --- a/src/BNFC/Backend/Java/CFtoCup15.hs +++ b/src/BNFC/Backend/Java/CFtoCup15.hs @@ -14,18 +14,19 @@ -} -module BNFC.Backend.Java.CFtoCup15 ( cf2Cup, definedRules ) where +module BNFC.Backend.Java.CFtoCup15 ( cf2Cup ) where +import Data.Char +import Data.List (intercalate) + import BNFC.CF -import Data.List -import BNFC.Backend.Common.NamedVariables -import BNFC.Backend.Java.CFtoJavaAbs15 (typename) import BNFC.Options (RecordPositions(..)) import BNFC.Utils ( (+++) ) -import BNFC.TypeChecker -- We need to (re-)typecheck to figure out list instances in - -- defined rules. -import Data.Char +import BNFC.Backend.Common.NamedVariables +import BNFC.Backend.Java.CFtoJavaAbs15 ( typename ) +import BNFC.Backend.Java.Utils ( getRuleName ) + type Rules = [(NonTerminal,[(Pattern,Action)])] type Pattern = String type Action = String @@ -61,9 +62,6 @@ , ":}" , "parser code {:" , parseMethod packageAbsyn (firstEntry cf) - , "public > " - ++ "A cons_(B x, A xs) { xs.addFirst(x); return xs; }" - , unlines $ definedRules packageAbsyn cf , "public void syntax_error(java_cup.runtime.Symbol cur_token)" , "{" , " report_error(\"Syntax Error, trying to recover and continue" @@ -79,56 +77,7 @@ , ":}" ] -definedRules :: String -> CF -> [String] -definedRules packageAbsyn cf = - concat [ rule f xs e | FunDef f xs e <- cfgPragmas cf ] - where - ctx = buildContext cf - list = LC (\ t -> "List" ++ unBase t) (const "cons") - where - unBase (ListT t) = unBase t - unBase (BaseT x) = show $ normCat $ strToCat x - - rule f xs e = - case runTypeChecker $ checkDefinition' list ctx f xs e of - Left err -> - error $ "Panic! This should have been caught already:\n" - ++ err - Right (args,(e',t)) -> - [ "public " ++ javaType t ++ " " ++ funName f ++ "_ (" ++ - intercalate ", " (map javaArg args) ++ ") {" - , " return " ++ javaExp e' ++ ";" - , "}" - ] - where - - javaType :: Base -> String - javaType (ListT (BaseT x)) = packageAbsyn ++ ".List" - ++ catToStr (normCat $ strToCat x) - javaType (ListT t) = javaType t - javaType (BaseT x) = typename packageAbsyn (ctxTokens ctx) $ - catToStr $ normCat $ strToCat x - - javaArg :: (String, Base) -> String - javaArg (x,t) = javaType t ++ " " ++ x ++ "_" - - javaExp :: Exp -> String - javaExp (App "null" []) = "null" - javaExp (Var x) = x ++ "_" -- argument - javaExp (App t [e]) - | isToken t ctx = call "new String" [e] - javaExp (App x es) - | isUpper (head x) = call ("new " ++ packageAbsyn ++ "." ++ x) es - | otherwise = call (x ++ "_") es - javaExp (LitInt n) = "new Integer(" ++ show n ++ ")" - javaExp (LitDouble x) = "new Double(" ++ show x ++ ")" - javaExp (LitChar c) = "new Character(" ++ show c ++ ")" - javaExp (LitString s) = "new String(" ++ show s ++ ")" - - call x es = x ++ "(" ++ intercalate ", " (map javaExp es) ++ ")" - - -- peteg: FIXME JavaCUP can only cope with one entry point AFAIK. prEntryPoint :: CF -> String prEntryPoint cf = unlines ["", "start with " ++ identCat (firstEntry cf) ++ ";", ""] @@ -212,11 +161,12 @@ | isConsFun f = "RESULT = " ++ p_2 ++ "; " ++ p_2 ++ "." ++ add ++ "(" ++ p_1 ++ ");" | isCoercion f = "RESULT = " ++ p_1 ++ ";" - | isDefinedRule f = "RESULT = parser." ++ f ++ "_" + | isDefinedRule f = "RESULT = " ++ packageAbsyn ++ "Def." ++ sanitize f ++ "(" ++ intercalate "," ms ++ ");" | otherwise = "RESULT = new " ++ c ++ "(" ++ intercalate "," ms ++ ");" ++ lineInfo where + sanitize = getRuleName f = funName fun c = packageAbsyn ++ "." ++ if isNilFun f || isOneFun f || isConsFun f diff --git a/src/BNFC/Backend/Java/CFtoJavaAbs15.hs b/src/BNFC/Backend/Java/CFtoJavaAbs15.hs --- a/src/BNFC/Backend/Java/CFtoJavaAbs15.hs +++ b/src/BNFC/Backend/Java/CFtoJavaAbs15.hs @@ -24,17 +24,22 @@ module BNFC.Backend.Java.CFtoJavaAbs15 (cf2JavaAbs, typename, cat2JavaType) where +import Data.Bifunctor ( first ) +import Data.Char ( isUpper, toLower ) +import Data.Function ( on ) +import Data.List ( findIndices, intercalate ) +import Data.Maybe ( mapMaybe ) +import System.FilePath ( (<.>), () ) +import Text.PrettyPrint as P + import BNFC.CF -import BNFC.Options (RecordPositions(..)) -import BNFC.Utils((+++),(++++)) -import BNFC.Backend.Common.NamedVariables hiding (IVar, getVars, varName) -import Data.Function (on) -import Data.List -import Data.Char(toLower) -import Data.Maybe (mapMaybe) -import Text.PrettyPrint -import qualified Text.PrettyPrint as P +import BNFC.Options ( RecordPositions(..) ) +import BNFC.TypeChecker ( buildContext, ctxTokens, isToken ) +import BNFC.Utils ( (+++), (++++), uncurry3, unless ) +import BNFC.Backend.Common.NamedVariables ( UserDef, showNum ) +import BNFC.Backend.Java.Utils ( getRuleName ) + --Produces abstract data types in Java. --These follow Appel's "non-object oriented" version. --They also allow users to use the Visitor design pattern. @@ -44,17 +49,85 @@ -- a number unique to that type, -- and an optional name (handles typedefs). --- | The result is a list of files which must be written to disk. +-- | The result is a list of files (without file extension) +-- which must be written to disk. -- The tuple is (FileName, FileContents) -cf2JavaAbs :: String -> String -> CF -> RecordPositions -> [(FilePath, String)] -cf2JavaAbs _ packageAbsyn cf rp = - concatMap (prData rp header packageAbsyn user) rules - where +cf2JavaAbs :: FilePath -- ^ Directory for AST without trailing 'pathSeparator'. + -> String -> String -> CF -> RecordPositions -> [(FilePath, String)] +cf2JavaAbs dirAbsyn packageBase packageAbsyn cf rp = concat + [ unless (null defs) + [ (dirAbsyn ++ "Def", unlines deftext) ] + , map (first mkPath) $ concatMap (prData rp header packageAbsyn user) rules + ] + where header = "package " ++ packageAbsyn ++ "; // Java Package generated by the BNF Converter.\n" - user = [n | (n,_) <- tokenPragmas cf] - rules = getAbstractSyntax cf + user = [ n | (n,_) <- tokenPragmas cf ] + rules = getAbstractSyntax cf + defs = definitions cf + deftext= concat + [ [ "package " ++ packageBase ++ "; // Java Package generated by the BNF Converter." + , "" + , "public class AbsynDef {" + , "" + , " public static > A cons(B x, A xs) {" + , " xs.addFirst(x);" + , " return xs;" + , " }" + , "" + ] + , definedRules defs packageAbsyn cf + , [ "}"] + ] + mkPath :: String -> FilePath + mkPath s = dirAbsyn s +definedRules :: [Define] -> String -> CF -> [String] +definedRules defs packageAbsyn cf = map rule defs + where + ctx = buildContext cf + + rule (Define f args e t) = + unlines $ map (" " ++) $ + [ "public static " ++ javaType t ++ " " ++ sanitize (funName f) ++ "(" ++ + intercalate ", " (map javaArg args) ++ ") {" + , " return " ++ javaExp (map fst args) e ++ ";" + , "}" + ] + where + sanitize = getRuleName + + javaType :: Base -> String + javaType = \case + ListT (BaseT x) -> concat [ packageAbsyn, ".List", x ] + BaseT x -> typename packageAbsyn (ctxTokens ctx) x + -- ListT t -> javaType t -- undefined + + javaArg :: (String, Base) -> String + javaArg (x,t) = javaType t ++ " " ++ x + + javaExp :: [String] -> Exp -> String + javaExp args = \case + Var x -> x -- argument + App "[]" (FunT _ t) [] + -> callQ (identType t) [] + App "(:)" _ es -> call "cons" es + App t _ [e] + | isToken t ctx -> javaExp args e -- wraps new String + App x _ es + | isUpper (head x) -> callQ x es + | otherwise -> call (sanitize x) es + -- -- | x `elem` args -> call x es + LitInt n -> "new Integer(" ++ show n ++ ")" + LitDouble x -> "new Double(" ++ show x ++ ")" + LitChar c -> "new Character(" ++ show c ++ ")" + LitString s -> "new String(" ++ show s ++ ")" + where + call x es = x ++ "(" ++ intercalate ", " (map (javaExp args) es) ++ ")" + callQ = call . qualify + qualify x = "new " ++ packageAbsyn ++ "." ++ x + + -- | Generates a (possibly abstract) category class, and classes for all its rules. prData :: RecordPositions -> String -> String -> [UserDef] -> Data ->[(String, String)] @@ -63,8 +136,8 @@ where funs = map fst rules categoryClass - | show cat `elem` funs = [] -- the catgory is also a function, skip abstract class - | otherwise = [(identCat cat, header ++++ + | catToStr cat `elem` funs = [] -- the catgory is also a function, skip abstract class + | otherwise = [(cls, header ++++ unlines [ "public abstract class" +++ cls +++ "implements java.io.Serializable {", @@ -115,14 +188,14 @@ where vs = getVars cats user fun' = identCat (normCat c) - isAlsoCategory = fun == show c + isAlsoCategory = fun == catToStr c --This handles the case where a LBNF label is the same as the category. ext = if isAlsoCategory then "" else " extends" +++ identCat c -- | The standard accept function for the Visitor pattern. prAccept :: String -> Cat -> String -> String -prAccept pack cat _ = "\n public R accept(" ++ pack ++ "." ++ show cat +prAccept pack cat _ = "\n public R accept(" ++ pack ++ "." ++ catToStr cat ++ ".Visitor v, A arg) { return v.visit(this, arg); }\n" -- | Creates the equals() method. diff --git a/src/BNFC/Backend/Java/CFtoJavaPrinter15.hs b/src/BNFC/Backend/Java/CFtoJavaPrinter15.hs --- a/src/BNFC/Backend/Java/CFtoJavaPrinter15.hs +++ b/src/BNFC/Backend/Java/CFtoJavaPrinter15.hs @@ -29,17 +29,20 @@ import Prelude hiding ((<>)) -import BNFC.Backend.Java.CFtoJavaAbs15 +import Data.Bifunctor ( second ) +import Data.Char ( toLower, isSpace ) +import Data.Either ( lefts ) +import Data.List ( intersperse ) +import Data.Maybe ( isJust ) import BNFC.CF -import BNFC.Backend.Common (renderListSepByPrecedence) -import BNFC.Backend.Common.NamedVariables -import BNFC.Utils ( (+++) ) -import Data.List -import Data.Char ( toLower, isSpace ) -import Data.Either (lefts) import BNFC.PrettyPrint +import BNFC.Utils ( (+++), for, unless, unlessNull, uniqOn ) +import BNFC.Backend.Common ( switchByPrecedence ) +import BNFC.Backend.Common.NamedVariables +import BNFC.Backend.Java.CFtoJavaAbs15 + --Produces the PrettyPrinter class. --It will generate two methods "print" and "show" --print is the actual pretty printer for linearization. @@ -81,7 +84,9 @@ " private static void sh(Double d) { render(String.format(java.util.Locale.ROOT, \"%.15g\", d)); }", " private static void sh(Character c) { render(\"'\" + c.toString() + \"'\"); }", " private static void sh(String s) { printQuoted(s); }", + "", " private static void printQuoted(String s) { render(\"\\\"\" + s + \"\\\"\"); }", + "", " private static void indent()", " {", " int n = _n_;", @@ -91,12 +96,14 @@ " n--;", " }", " }", + "", " private static void backup()", " {", " int prev = buf_.length() - 1;", - " if (buf_.charAt(prev) == ' ')", + " if (prev >= 0 && buf_.charAt(prev) == ' ')", " buf_.setLength(prev);", " }", + "", " private static void trim()", " {", " // Trim initial spaces", @@ -106,11 +113,33 @@ " end++; ", " buf_.delete(0, end);", " // Trim trailing spaces", - " end = buf_.length();", + " removeTrailingSpaces();", + " }", + "", + " private static void removeTrailingSpaces()", + " {", + " int end = buf_.length();", " while (end > 0 && buf_.charAt(end-1) == ' ')", - " end--; ", + " end--;", " buf_.setLength(end);", " }", + "", + " private static void removeTrailingWhitespace()", + " {", + " int end = buf_.length();", + " while (end > 0 && (buf_.charAt(end-1) == ' ' || buf_.charAt(end-1) == '\\n'))", + " end--;", + " buf_.setLength(end);", + " }", + "", + " private static void onEmptyLine()", + " {", + " removeTrailingSpaces();", + " int len = buf_.length();", + " if (len > 0 && buf_.charAt(len-1) != '\\n') buf_.append(\"\\n\");", + " indent();", + " }", + "", " private static int _n_ = 0;", " private static StringBuilder buf_ = new StringBuilder(INITIAL_BUFFER_SIZE);", "}" @@ -125,8 +154,7 @@ " {", " if (s.equals(\"{\"))", " {", - " buf_.append(\"\\n\");", - " indent();", + " onEmptyLine();", " buf_.append(s);", " _n_ = _n_ + INDENT_WIDTH;", " buf_.append(\"\\n\");", @@ -136,30 +164,27 @@ " buf_.append(s);", " else if (s.equals(\")\") || s.equals(\"]\"))", " {", - " backup();", + " removeTrailingWhitespace();", " buf_.append(s);", " buf_.append(\" \");", " }", " else if (s.equals(\"}\"))", " {", - " int t;", " _n_ = _n_ - INDENT_WIDTH;", - " for(t=0; t [UserDef] -> (Cat, [Rule]) -> String -prData packageAbsyn user (cat, rules) = unlines k - where - k = if isList cat - then - [" private static void pp(" ++ packageAbsyn ++ "." - ++ identCat (normCat cat) +++ "foo, int _i_)" - , " {" - , render $ nest 5 $ prList packageAbsyn user cat rules <> " }" - ] - else --not a list - [ - " private static void pp(" ++ packageAbsyn ++ "." - ++ identCat (normCat cat) +++ "foo, int _i_)", - " {", - concat (addElse $ map (prRule packageAbsyn) rules) ++ " }" - ] - addElse = map (" "++). intersperse "else " . filter (not . null) - . map (dropWhile isSpace) +prData packageAbsyn user (cat, rules) + | isList cat = unlines $ concat + [ [ " private static void pp(" ++ packageAbsyn ++ "." ++ dat ++ " foo, int _i_)" + , " {" + , " pp" ++ dat ++ "(foo.iterator(), _i_);" + , " }" + , "" + , " private static void pp" ++ dat ++ "(java.util.Iterator<" ++ et ++ "> it, int _i_)" + , " {" + ] + , map (" " ++) $ prList dat et rules + , [ " }" + , "" + ] + ] + | otherwise = unlines $ + [ " private static void pp(" ++ packageAbsyn ++ "." + ++ dat +++ "foo, int _i_)" + , " {" + , concat (addElse $ map (prRule packageAbsyn) rules) + , " }" + ] + where + dat = identCat (normCat cat) + et = typename packageAbsyn user $ identCat $ normCatOfList cat + addElse = map (" " ++) . intersperse "else " . filter (not . null) + . map (dropWhile isSpace) prRule :: String -> Rule -> String @@ -245,58 +279,75 @@ " if (_i_ > " ++ show p ++ ") render(_R_PAREN);\n") cats' = case cats of [] -> "" - _ -> concatMap (render . prCat (text fnm)) (numVars cats) + _ -> concatMap (render . prItem (text fnm)) (numVars cats) fnm = '_' : map toLower fun prRule _nm _ = "" --- | --- --- >>> let lfoo = ListCat (Cat "Foo") --- >>> prList "absyn" [] lfoo [npRule "[]" lfoo [] Parsable, npRule "(:)" lfoo [Left (Cat "Foo"), Right ".", Left lfoo] Parsable] --- for (java.util.Iterator it = foo.iterator(); it.hasNext();) --- { --- pp(it.next(), _i_); --- if (it.hasNext()) { --- render("."); --- } else { --- render("."); --- } --- } +prList :: String -> String -> [Rule] -> [String] +prList dat et rules = concat + [ if null docs0 then + [ "if (it.hasNext())" ] + else + [ "if (!it.hasNext())" + , "{ /* nil */" + , render $ nest 4 $ vcat docs0 + , "}" + , "else" + ] + , if null docs1 then + [ "{ /* cons */" + , " " ++ et ++ " el = it.next();" + ] + else + [ "{" + , " " ++ et ++ " el = it.next();" + , " if (!it.hasNext())" + , " { /* last */" + , render $ nest 4 $ vcat docs1 + , " }" + , " else" + , " { /* cons */" + ] + , unlessNull (swRules isConsFun) $ \ docs -> + [ render $ nest (if null docs1 then 2 else 4) $ vcat docs + ] + , unless (null docs1) [ " }" ] + , [ "}" ] + ] + where + prules = sortRulesByPrecedence rules + swRules f = switchByPrecedence "_i_" $ + map (second $ sep . map text . prListRule_ dat) $ + uniqOn fst $ filter f prules + -- Discard duplicates, can only handle one rule per precedence. + docs0 = swRules isNilFun + docs1 = swRules isOneFun -prList :: String -> [UserDef] -> Cat -> [Rule] -> Doc -prList packageAbsyn user c rules = - "for (java.util.Iterator<" <> et <> "> it = foo.iterator(); it.hasNext();)" - $$ codeblock 2 - [ "pp(it.next(), _i_);" - , "if (it.hasNext()) {" - , nest 2 (renderListSepByPrecedence "_i_" renderSep - (getSeparatorByPrecedence rules)) - , "} else {" - , nest 2 (renderSep optsep <> ";") - , "}" - ] - where - et = text $ typename packageAbsyn user $ identCat $ normCatOfList c - sep = escapeChars $ getCons rules - optsep = if hasOneFunc rules then "" else sep - renderSep x = "render(\"" <> text x <>"\")" +-- | Only render the rhs (items) of a list rule. +prListRule_ :: IsFun a => String -> Rul a -> [String] +prListRule_ dat (Rule _ _ items _) = for items $ \case + Right t -> "render(\"" ++ escapeChars t ++ "\");" + Left (TokenCat "String") -> "printQuoted(el);" + Left (ListCat _) -> "pp" ++ dat ++ "(it, _i_);" + Left _ -> "pp(el, _i_);" + -- | --- >>> prCat "F" (Right "++") +-- >>> prItem "F" (Right "++") -- render("++"); -- --- >>> prCat "F" (Left (TokenCat "String", "string_")) +-- >>> prItem "F" (Left (TokenCat "String", "string_")) -- printQuoted(F.string_); -- --- >>> prCat "F" (Left (Cat "Abc", "abc_")) +-- >>> prItem "F" (Left (Cat "Abc", "abc_")) -- pp(F.abc_, 0); -- -prCat :: Doc -> Either (Cat, Doc) String -> Doc -prCat _ (Right t) = nest 7 ("render(\"" <> text(escapeChars t) <> "\");\n") -prCat fnm (Left (TokenCat "String", nt)) +prItem :: Doc -> Either (Cat, Doc) String -> Doc +prItem _ (Right t) = nest 7 ("render(\"" <> text(escapeChars t) <> "\");\n") +prItem fnm (Left (TokenCat "String", nt)) = nest 7 ("printQuoted(" <> fnm <> "." <> nt <> ");\n") -prCat fnm (Left (cat, nt)) +prItem fnm (Left (cat, nt)) = nest 7 ("pp(" <> fnm <> "." <> nt <> ", " <> integer (precCat cat) <> ");\n") --The following methods generate the Show function. diff --git a/src/BNFC/Backend/OCaml/CFtoOCamlAbs.hs b/src/BNFC/Backend/OCaml/CFtoOCamlAbs.hs --- a/src/BNFC/Backend/OCaml/CFtoOCamlAbs.hs +++ b/src/BNFC/Backend/OCaml/CFtoOCamlAbs.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} + {- BNF Converter: OCaml Abstract Syntax Generator Copyright (C) 2005 Author: Kristofer Johannisson @@ -11,15 +13,47 @@ import Text.PrettyPrint import BNFC.CF -import BNFC.Utils((+++)) -import Data.List(intersperse) +import BNFC.Utils ( (+++), unless, parensIf ) +import Data.List ( intersperse ) import BNFC.Backend.OCaml.OCamlUtil -- to produce an OCaml module cf2Abstract :: String -> CF -> String -cf2Abstract _ cf = unlines $ - "(* OCaml module generated by the BNF converter *)\n\n" : - mutualRecDefs (map (prSpecialData cf) (specialCats cf) ++ map prData (cf2data cf)) +cf2Abstract _ cf = unlines $ concat + [ [ "(* OCaml module generated by the BNF converter *)" + , "" + ] + , mutualRecDefs $ concat + [ map (prSpecialData cf) (specialCats cf) + , map prData (cf2data cf) + ] + , unless (null defs) $ concat + [ [ "(* defined constructors *)" + , "" + ] + , defs + ] + ] + where + defs = definedRules cf + +definedRules :: CF -> [String] +definedRules cf = map mkDef $ definitions cf + where + mkDef (Define f args e t) = + "let " ++ sanitizeOcaml (funName f) ++ " " ++ mkTuple (map fst args) ++ " = " ++ ocamlExp False e + + ocamlExp :: Bool -> Exp -> String + ocamlExp p = \case + Var s -> s + App "(:)" _ [e1, e2] -> parensIf p $ unwords [ ocamlExp True e1, "::", ocamlExp False e2 ] + App s _ [] -> sanitizeOcaml s + App s _ [e] -> parensIf p $ sanitizeOcaml s ++ ' ' : ocamlExp True e + App s _ es -> parensIf p $ sanitizeOcaml s ++ ' ' : mkTuple (map (ocamlExp False) es) + LitInt i -> show i + LitDouble d -> show d + LitChar c -> "\'" ++ c : "\'" + LitString s -> "\"" ++ s ++ "\"" -- allow mutual recursion so that we do not have to sort the type definitions in -- dependency order diff --git a/src/BNFC/Backend/OCaml/CFtoOCamlLex.hs b/src/BNFC/Backend/OCaml/CFtoOCamlLex.hs --- a/src/BNFC/Backend/OCaml/CFtoOCamlLex.hs +++ b/src/BNFC/Backend/OCaml/CFtoOCamlLex.hs @@ -27,12 +27,13 @@ import BNFC.Utils (cstring, unless) cf2ocamllex :: String -> String -> CF -> String -cf2ocamllex _ parserMod cf = - unlines $ List.intercalate [""] [ - header parserMod cf, - definitions cf, - [PP.render (rules cf)] - ] +cf2ocamllex _ parserMod cf = unlines $ List.intercalate [""] + [ header parserMod cf + , cMacros + , rMacros cf + , uMacros cf + , [ PP.render $ rules cf ] + ] header :: String -> CF -> [String] header parserMod cf = List.intercalate [""] . filter (not . null) $ concat @@ -93,14 +94,6 @@ where keyvals = map (\ s -> concat [ "(", mkEsc s, ", ", terminal cf s, ")" ]) syms - -definitions :: CF -> [String] -definitions cf = concat $ - [ cMacros - , rMacros cf - , uMacros cf - ] - cMacros :: [String] cMacros = [ "(* BNFC character classes *)" @@ -110,7 +103,6 @@ , "let _digit = ['0'-'9'] (* _digit *)" , "let _idchar = _letter | _digit | ['_' '\\''] (* identifier character *)" , "let _universal = _ (* universal: any character *)" - , "" ] rMacros :: CF -> [String] diff --git a/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs b/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs --- a/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs +++ b/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs @@ -57,7 +57,7 @@ " let _ = printer 0 tree buffer 0 in (* discard return value *)", " Buffer.contents buffer", "", - "let indent_width = 4", + "let indent_width = 2", "", "let indent (i: int) : string = \"\\n\" ^ String.make i ' '", "", @@ -72,21 +72,22 @@ " (* invariant: last char of the buffer is never whitespace *)", " let n = Buffer.length buf in", " let last = if n = 0 then None else Some (Buffer.nth buf (n-1)) in", + " let newindent = match s with", + " \"{\" -> i + indent_width", + " | \"}\" -> i - indent_width", + " | _ -> i in", " let whitespace = match last with", " None -> \"\" ", - " | Some '{' -> indent i", " | Some '}' -> (match s with", " \";\" -> \"\"", - " | _ -> indent i)", - " | Some ';' -> indent i", - " | (Some '[') | (Some '(') -> \"\"", + " | _ -> indent newindent)", + " | (Some '{') | (Some ';') -> if s = \"}\" then indent newindent else indent i", + " | (Some '[') | (Some '(') -> \"\"", " | Some c -> if isWhiteSpace c then \"\" else (match s with", - " \",\" | \")\" | \"]\" -> \"\"", + " \";\" | \",\" | \")\" | \"]\" -> \"\"", + " | \"{\" -> indent i", + " | \"}\" -> indent newindent", " | _ -> if String.trim s = \"\" then \"\" else \" \") in", - " let newindent = match s with", - " \"{\" -> i + indent_width", - " | \"}\" -> i - indent_width", - " | _ -> i in", " Buffer.add_string buf whitespace;", " Buffer.add_string buf s;", " newindent", @@ -150,7 +151,7 @@ var (Cat "String") = "str" var (Cat "Char") = "c" var (Cat "Double") = "d" - var xs = map toLower (show xs) + var xs = map toLower (catToStr xs) ruleOf s = fromJust $ lookupRule (noPosition s) (cfgRules cf) --- case_fun :: Cat -> [(Constructor,Rule)] -> String diff --git a/src/BNFC/Backend/OCaml/CFtoOCamlShow.hs b/src/BNFC/Backend/OCaml/CFtoOCamlShow.hs --- a/src/BNFC/Backend/OCaml/CFtoOCamlShow.hs +++ b/src/BNFC/Backend/OCaml/CFtoOCamlShow.hs @@ -100,7 +100,7 @@ var (Cat "String") = "str" var (Cat "Char") = "c" var (Cat "Double") = "d" - var cat = map toLower (show cat) + var cat = map toLower (catToStr cat) checkRes s | elem s reservedOCaml = s ++ "'" | otherwise = s diff --git a/src/BNFC/Backend/OCaml/CFtoOCamlTemplate.hs b/src/BNFC/Backend/OCaml/CFtoOCamlTemplate.hs --- a/src/BNFC/Backend/OCaml/CFtoOCamlTemplate.hs +++ b/src/BNFC/Backend/OCaml/CFtoOCamlTemplate.hs @@ -11,8 +11,8 @@ cf2Template ) where -import BNFC.CF import Data.Char +import BNFC.CF import BNFC.Backend.OCaml.OCamlUtil @@ -44,7 +44,7 @@ var (Cat "String") = "str" var (Cat "Char") = "c" var (Cat "Double") = "d" - var cat = map toLower (show cat) + var cat = map toLower (catToStr cat) checkRes s | elem s reservedOCaml = s ++ "'" | otherwise = s @@ -53,5 +53,5 @@ case_fun :: Cat -> [Constructor] -> String case_fun cat xs = unlines $ - ["trans" ++ show cat ++ " (x : " ++ fixType cat ++ ") : result = match x with", + ["trans" ++ catToStr cat ++ " (x : " ++ fixType cat ++ ") : result = match x with", unlines $ insertBar $ map (\s -> s ++ " -> " ++ "failure x") xs] diff --git a/src/BNFC/Backend/OCaml/CFtoOCamlYacc.hs b/src/BNFC/Backend/OCaml/CFtoOCamlYacc.hs --- a/src/BNFC/Backend/OCaml/CFtoOCamlYacc.hs +++ b/src/BNFC/Backend/OCaml/CFtoOCamlYacc.hs @@ -47,24 +47,9 @@ "open " ++ absName, "open Lexing", "", - definedRules cf, "%}" ] -definedRules :: CF -> String -definedRules cf = unlines [ mkDef f xs e | FunDef f xs e <- cfgPragmas cf ] - where - mkDef f xs e = "let " ++ funName f ++ " " ++ mkTuple xs ++ " = " ++ ocamlExp e - - ocamlExp :: Exp -> String - ocamlExp = \case - Var s -> s - App s es -> s ++ ' ' : mkTuple (map ocamlExp es) - LitInt i -> show i - LitDouble d -> show d - LitChar c -> "\'" ++ c : "\'" - LitString s -> "\"" ++ s ++ "\"" - declarations :: String -> CF -> String declarations absName cf = unlines @@ -196,7 +181,7 @@ f' = case funName f of -- ocaml cons is somehow not a standard infix oper, right? "(:[])" -> "(fun x -> [x])" "(:)" -> "(fun (x,xs) -> x::xs)" - x -> x + x -> sanitizeOcaml x generatePatterns :: (String -> String) -> Rule -> (Pattern,[MetaVar]) diff --git a/src/BNFC/Backend/OCaml/OCamlUtil.hs b/src/BNFC/Backend/OCaml/OCamlUtil.hs --- a/src/BNFC/Backend/OCaml/OCamlUtil.hs +++ b/src/BNFC/Backend/OCaml/OCamlUtil.hs @@ -52,6 +52,12 @@ "true","try","type","val","virtual","when", "while","with"] +-- | Avoid clashes with keywords. +sanitizeOcaml :: String -> String +sanitizeOcaml s + | s `elem` reservedOCaml = s ++ "_" + | otherwise = s + -- | Keywords of @ocamllex@. reservedOCamlLex :: [String] reservedOCamlLex = diff --git a/src/BNFC/Backend/Txt2Tag.hs b/src/BNFC/Backend/Txt2Tag.hs --- a/src/BNFC/Backend/Txt2Tag.hs +++ b/src/BNFC/Backend/Txt2Tag.hs @@ -6,10 +6,12 @@ module BNFC.Backend.Txt2Tag (cfToTxt)where -import BNFC.CF +import qualified Data.List as List + import BNFC.Abs (Reg (..)) +import BNFC.CF +import BNFC.PrettyPrint import BNFC.Utils -import Data.List cfToTxt :: String -> CF -> String cfToTxt name cf = unlines [ @@ -103,8 +105,8 @@ "Multiple-line comments are enclosed with " ++ mult ++"." ] where - sing = intercalate ", " $ map (symbol.prt) ys - mult = intercalate ", " $ + sing = List.intercalate ", " $ map (symbol.prt) ys + mult = List.intercalate ", " $ map (\(x,y) -> symbol (prt x) ++ " and " ++ symbol (prt y)) xs prtSymb :: String -> CF -> String @@ -147,7 +149,7 @@ "Non-terminals are enclosed between < and >. ", "The symbols " ++ arrow ++ " (production), " ++ delimiter ++" (union) ", - "and " ++ empty ++ " (empty rule) belong to the BNF notation. ", + "and " ++ eps ++ " (empty rule) belong to the BNF notation. ", "All other symbols are terminals.", "", prtRules (ruleGroups cf) @@ -164,7 +166,7 @@ prtRules xs prtSymbols :: [Either Cat String] -> String -prtSymbols [] = empty +prtSymbols [] = eps prtSymbols xs = foldr ((+++) . p) [] xs where p (Left r) = nonterminal r p (Right r) = terminal r @@ -172,20 +174,20 @@ prt :: String -> String prt s = s -empty :: String -empty = "**eps**" +eps :: String +eps = "**eps**" symbol :: String -> String symbol s = s tabular :: Int -> [[String]] -> String -tabular _ xs = unlines [unwords (intersperse "|" (" " : x)) | x <- xs] +tabular _ xs = unlines [unwords (List.intersperse "|" (" " : x)) | x <- xs] terminal :: String -> String terminal s = "``" ++ s ++ "``" nonterminal :: Cat -> String -nonterminal s = "//" ++ show s ++ "//" +nonterminal cat = "//" ++ prettyShow cat ++ "//" arrow :: String arrow = "->" diff --git a/src/BNFC/Backend/XML.hs b/src/BNFC/Backend/XML.hs --- a/src/BNFC/Backend/XML.hs +++ b/src/BNFC/Backend/XML.hs @@ -7,10 +7,13 @@ module BNFC.Backend.XML ---- (cf2DTD, cf2XML) where +import Prelude hiding ((<>)) + import Data.Bifunctor ( second ) import Data.List ( intercalate ) import BNFC.CF +import BNFC.PrettyPrint import BNFC.Utils import BNFC.Backend.Base import BNFC.Options hiding ( Backend ) @@ -56,7 +59,7 @@ elemt t = elemAtt t "name" elemc :: Cat -> [(Fun, String)] -> String -elemc cat fs = unlines $ element (show cat) (map snd fs) : [element f [] | (f,_) <- fs] +elemc cat fs = unlines $ element (prettyShow cat) (map snd fs) : [element f [] | (f,_) <- fs] elemEmp :: String -> String elemEmp t = elemAtt t "value" [] @@ -102,21 +105,24 @@ -- efunDefAttr = "elemFun i t x = [replicate (i+i) ' ' ++ tag (t ++ \" name = \" ++ x)]" rhsCat :: CF -> Fun -> [Cat] -> String -rhsCat cf fun cs = parenth (intercalate ", " (fun:map (symbCat cf) cs)) -rhsCatNot cf cs = if null cs then "EMPTY" else intercalate", " (map (symbCatNot cf) cs) +rhsCat cf fun cs = parenth (intercalate ", " (fun : map (render . symbCat cf) cs)) +rhsCatNot cf cs = if null cs then "EMPTY" else intercalate ", " (map (render . symbCatNot cf) cs) +symbCat :: CF -> Cat -> Doc symbCat cf c - | isList c = show (normCatOfList c) ++ if isEmptyListCat cf c then "*" else "+" - | otherwise = show c + | isList c = pretty (normCatOfList c) <> if isEmptyListCat cf c then "*" else "+" + | otherwise = pretty c +symbCatNot :: CF -> Cat -> Doc symbCatNot cf c - | isList c = funs (normCatOfList c) ++ if isEmptyListCat cf c then "*" else "+" + | isList c = funs (normCatOfList c) <> if isEmptyListCat cf c then "*" else "+" | otherwise = funs c where - funs k = case lookup k (cf2data cf) of - Just [] -> "EMPTY" - Just fcs -> parenth $ intercalate " | " $ map fst fcs - _ -> parenth (show k) ---- + funs k = + case lookup k (cf2data cf) of + Just [] -> "EMPTY" + Just fcs -> parens $ sep $ punctuate "|" $ map (text . fst) fcs + _ -> parens $ pretty k parenth s = "(" ++ s ++ ")" @@ -220,12 +226,14 @@ case_fun :: Cat -> [(String, [String])] -> String case_fun cat xs = unlines $ concat - [ [ "instance XPrint" +++ show cat +++ "where" + [ [ "instance XPrint" +++ s +++ "where" , " prt i'" +++ "= \\case" ] , (`map` xs) $ \ (c, xx) -> " " ++ c +++ unwords xx +++ "-> P.concat $ " +++ - "elemFun i' \"" ++ show cat ++ "\" \"" ++ c ++ "\"" +++ + "elemFun i' \"" ++ s ++ "\" \"" ++ c ++ "\"" +++ unwords [": prt (i'+1)" +++ x | x <- xx] +++ ":" +++ - "[[P.replicate (i'+i') ' ' ++ endtag \"" ++ c ++ "\" \"" ++ show cat ++ "\"]]" + "[[P.replicate (i'+i') ' ' ++ endtag \"" ++ c ++ "\" \"" ++ s ++ "\"]]" ] + where + s = prettyShow cat diff --git a/src/BNFC/CF.hs b/src/BNFC/CF.hs --- a/src/BNFC/CF.hs +++ b/src/BNFC/CF.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveTraversable #-} -- implies DeriveFunctor, DeriveFoldable {-# LANGUAGE FlexibleInstances #-} -- implies TypeSynonymInstances {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} @@ -8,96 +9,21 @@ {- BNF Converter: Abstract syntax Copyright (C) 2004 Author: Markus Forsberg, Michael Pellauer, Aarne Ranta - + Copyright (C) 2017-2021 Andreas Abel -} -module BNFC.CF ( - -- Types. - CF, - CFG(..), - Rule, Rul(..), npRule, valCat, lookupRule, InternalRule(..), - Pragma(..), - Exp(..), - Base(..), Type(..), Signature, - Literal, - Symbol, - KeyWord, - Position(..), noPosition, prettyPosition, npIdentifier, - WithPosition(..), blendInPosition, - RString, RCat, - Cat(..), strToCat, catToStr, - BaseCat, TokenCat, - catString, catInteger, catDouble, catChar, catIdent, - NonTerminal, SentForm, - Fun, RFun, IsFun(..), - Data, -- describes the abstract syntax of a grammar - cf2data, -- translates a grammar to a Data object. - cf2dataLists, -- translates to a Data with List categories included. - getAbstractSyntax, - -- Literal categories, constants, - firstEntry, -- the first entry or the first value category - baseTokenCatNames, -- "Char", "Double", "Integer", "String" - specialCats, -- ident - specialCatsP, -- all literals - specialData, -- special data - isCoercion, -- wildcards in grammar (avoid syntactic clutter) - isDefinedRule, -- defined rules (allows syntactic sugar) - isProperLabel, -- not coercion or defined rule - allCats, -- all categories of a grammar - allParserCats, allParserCatsNorm, - reallyAllCats, - allCatsNorm, - allCatsIdNorm, - allEntryPoints, - reservedWords, - cfTokens, - literals, - findAllReversibleCats, -- find all reversible categories - identCat, -- transforms '[C]' to ListC (others, unchanged). - isParsable, - rulesForCat, -- rules for a given category - rulesForNormalizedCat, -- rules for a given category - ruleGroups, -- Categories are grouped with their rules. - ruleGroupsInternals, --As above, but includes internal cats. - allNames, -- Checking for non-unique names, like @Name. Name ::= Ident;@. - filterNonUnique, - isList, -- Checks if a category is a list category. - isTokenCat, maybeTokenCat, - baseCat, - sameCat, - -- Information functions for list functions. - isNilFun, -- empty list function? ([]) - isOneFun, -- one element list function? (:[]) - hasOneFunc, - getCons, - getSeparatorByPrecedence, - isConsFun, -- constructor function? (:) - isNilCons, -- either three of above? - isEmptyListCat, -- checks if the list permits [] - revSepListRule, -- reverse a rule, if it is of form C t [C]. - normCat, - isDataCat, isDataOrListCat, - normCatOfList, -- Removes precendence information and enclosed List. C1 => C, C2 => C - catOfList, - comments, -- translates the pragmas into two list containing the s./m. comments - numberOfBlockCommentForms, - tokenPragmas, -- get the user-defined regular expression tokens - tokenNames, -- get the names of all user-defined tokens - precCat, -- get the precendence level of a Cat C1 => 1, C => 0 - precRule, -- get the precendence level of the value category of a rule. - isUsedCat, - isPositionCat, - hasPositionTokens, - hasIdent, hasIdentLikeTokens, - hasLayout, - layoutPragmas, - sigLookup -- Get the type of a rule label. - ) where +module BNFC.CF where -import Control.Monad (guard) +import Prelude hiding ((<>)) + +import Control.Arrow ( (&&&) ) +import Control.Monad ( guard ) + import Data.Char -import Data.Function (on) -import Data.List (nub, intersperse, sort, group, intercalate, find) +import Data.Ord ( Down(..) ) +import qualified Data.Either as Either +import Data.Function ( on ) +import Data.List ( nub, intersperse, sort, group, intercalate, find ) import qualified Data.List as List import Data.List.NonEmpty (pattern (:|), (<|)) import qualified Data.List.NonEmpty as List1 @@ -113,7 +39,8 @@ import BNFC.Lex (tokens) import qualified BNFC.Abs as Abs -import BNFC.Utils (spanEnd) +import BNFC.PrettyPrint +import BNFC.Utils (headWithDefault, spanEnd) type List1 = List1.NonEmpty @@ -154,10 +81,10 @@ | Parsable -- ^ ordinary rule (also for parser) deriving (Eq) -instance (Show function) => Show (Rul function) where - show (Rule f cat rhs internal) = unwords $ - (if internal == Internal then ("internal" :) else id) $ - show f : "." : show cat : "::=" : map (either show id) rhs +instance Pretty function => Pretty (Rul function) where + pretty (Rule f cat rhs internal) = + (if internal == Internal then ("internal" <+>) else id) $ + pretty f <> "." <+> pretty cat <+> "::=" <+> sep (map (either pretty (text . show)) rhs) -- | A sentential form is a sequence of non-terminals or terminals. type SentForm = [Either Cat String] @@ -178,8 +105,8 @@ } deriving (Functor) -instance (Show function) => Show (CFG function) where - show CFG{..} = unlines $ map show cfgRules +-- instance (Show function) => Show (CFG function) where +-- show CFG{..} = unlines $ map show cfgRules -- | Types of the rule labels, together with the position of the rule label. type Signature = Map String (WithPosition Type) @@ -193,6 +120,14 @@ data Type = FunT [Base] Base deriving (Eq, Ord) +-- | Placeholder for a type. +dummyBase :: Base +dummyBase = BaseT "" + +-- | Placeholder for a function type. +dummyType :: Type +dummyType = FunT [] dummyBase + instance Show Base where show (BaseT x) = x show (ListT t) = "[" ++ show t ++ "]" @@ -202,44 +137,39 @@ -- | Expressions for function definitions. -data Exp - = App String [Exp] -- ^ (Possibly defined) label applied to expressions. - | Var String -- ^ Function parameter. - | LitInt Integer +data Exp' f + = App f Type [Exp' f] -- ^ (Possibly defined) label applied to expressions. + -- The function 'Type' is inferred by the type checker. + | Var String -- ^ Function parameter. + | LitInt Integer | LitDouble Double - | LitChar Char + | LitChar Char | LitString String deriving (Eq) -instance Show Exp where - showsPrec p e = - case listView e of - Right es -> - showString "[" - . foldr (.) id (intersperse (showString ", ") $ map shows es) - . showString "]" - Left (Var x) -> showString x - Left (App x []) -> showString x - Left (App "(:)" [e1,e2]) -> - showParen (p>0) - $ showsPrec 1 e1 - . showString " : " - . shows e2 - Left (App x es) -> - showParen (p>1) - $ foldr (.) id - $ intersperse (showString " ") - $ showString x : map (showsPrec 2) es - Left (LitInt n) -> shows n - Left (LitDouble x) -> shows x - Left (LitChar c) -> shows c - Left (LitString s) -> shows s - where - listView (App "[]" []) = Right [] - listView (App "(:)" [e1,e2]) - | Right es <- listView e2 = Right $ e1:es - listView x = Left x +type Exp = Exp' String +instance (IsFun f, Pretty f) => Pretty (Exp' f) where + prettyPrec p e = + case listView e of + Right es -> brackets $ hcat $ punctuate ", " $ map (prettyPrec 0) es + Left (Var x) -> text x + Left (App f _ []) -> prettyPrec p f + Left (App f _ [e1,e2]) + | isConsFun f -> parensIf (p > 0) $ hsep [ prettyPrec 1 e1, ":", prettyPrec 0 e2 ] + Left (App f _ es) -> parensIf (p > 1) $ hsep $ prettyPrec 1 f : map (prettyPrec 2) es + Left (LitInt n) -> (text . show) n + Left (LitDouble x) -> (text . show) x + Left (LitChar c) -> (text . show) c + Left (LitString s) -> (text . show) s + where + listView (App f _ []) + | isNilFun f = Right [] + listView (App f _ [e1,e2]) + | isConsFun f + , Right es <- listView e2 = Right $ e1:es + listView e0 = Left e0 + -- | Pragmas. data Pragma @@ -247,12 +177,45 @@ | CommentM (String, String) -- ^ for multiple-line comments. | TokenReg RString Bool Reg -- ^ for tokens | EntryPoints [RCat] - | Layout [String] - | LayoutStop [String] - | LayoutTop - | FunDef RFun [String] Exp - deriving (Show) + | Layout LayoutKeyWords + | LayoutStop [KeyWord] + | LayoutTop Symbol -- ^ Separator for top-level layout. + | FunDef Define +data Define = Define + { defName :: RFun + , defArgs :: Telescope -- ^ Argument types inferred by the type checker. + , defBody :: Exp + , defType :: Base -- ^ Type of the body, inferred by the type checker. + } + +-- | Function arguments with type. +type Telescope = [(String, Base)] + +-- | For use with 'partitionEithers'. +isFunDef :: Pragma -> Either Pragma Define +isFunDef = \case + FunDef d -> Right d + p -> Left p + +-- | All 'define' pragmas of the grammar. +definitions :: CFG f -> [Define] +definitions cf = [ def | FunDef def <- cfgPragmas cf ] + +------------------------------------------------------------------------------ +-- Layout +------------------------------------------------------------------------------ + +type LayoutKeyWords = [(KeyWord, Delimiters)] + +-- | List delimiters. + +data Delimiters = Delimiters + { listSep :: Symbol -- ^ List separator. + , listOpen :: Symbol -- ^ List opening delimiter. + , listClose :: Symbol -- ^ List closing delimiter. + } deriving Show + -- | User-defined regular expression tokens tokenPragmas :: CFG f -> [(TokenCat,Reg)] tokenPragmas cf = [ (wpThing name, e) | TokenReg name _ e <- cfgPragmas cf ] @@ -261,17 +224,22 @@ tokenNames :: CFG f -> [String] tokenNames cf = map fst (tokenPragmas cf) -layoutPragmas :: CF -> (Bool,[String],[String]) -layoutPragmas cf = let ps = cfgPragmas cf in ( - not (null [() | LayoutTop <- ps]), -- if there's layout betw top-level - concat [ss | Layout ss <- ps], -- layout-block starting words - concat [ss | LayoutStop ss <- ps] -- layout-block ending words +layoutPragmas :: CF -> (Maybe Symbol, LayoutKeyWords, [KeyWord]) +layoutPragmas cf = + ( listToMaybe [ sep | LayoutTop sep <- ps ] -- if there's top-level layout + , concat [ kws | Layout kws <- ps ] -- layout-block inducing words + , concat [ kws | LayoutStop kws <- ps ] -- layout-block aborting words ) + where + ps = cfgPragmas cf +hasLayout_ :: (Maybe Symbol, LayoutKeyWords, [KeyWord]) -> Bool +hasLayout_ (top, kws, _) = isJust top || not (null kws) -- (True,[],_) means: top-level layout only + hasLayout :: CF -> Bool -hasLayout cf = case layoutPragmas cf of - (t,ws,_) -> t || not (null ws) -- (True,[],_) means: top-level layout only +hasLayout = hasLayout_ . layoutPragmas + -- | Literal: builtin-token types Char, String, Ident, Integer, Double. type Literal = String type Symbol = String @@ -304,6 +272,8 @@ instance Eq a => Eq (WithPosition a) where (==) = (==) `on` wpThing instance Ord a => Ord (WithPosition a) where compare = compare `on` wpThing +instance Pretty a => Pretty (WithPosition a) where pretty = pretty . wpThing + noPosition :: a -> WithPosition a noPosition = WithPosition NoPosition @@ -361,9 +331,18 @@ ListCat c -> "[" ++ catToStr c ++ "]" CoercCat s i -> s ++ show i +-- | This instance is for the Hspec test suite. instance Show Cat where show = catToStr +instance Pretty Cat where + pretty = \case + Cat s -> text s + TokenCat s -> text s + ListCat c -> brackets $ pretty c + CoercCat s i -> text s <> pretty i + + -- | Reads a string into a category. This should only need to handle -- the case of simple categories (with or without coercion) since list -- categories are parsed in the grammar already. To be on the safe side here, @@ -395,6 +374,7 @@ baseTokenCatNames :: [TokenCat] baseTokenCatNames = [ catChar, catDouble, catInteger, catString ] +-- all literals -- the parser needs these specialCatsP :: [TokenCat] specialCatsP = catIdent : baseTokenCatNames @@ -417,10 +397,7 @@ -- True sameCat :: Cat -> Cat -> Bool -sameCat (CoercCat c1 _) (CoercCat c2 _) = c1 == c2 -sameCat (Cat c1) (CoercCat c2 _) = c1 == c2 -sameCat (CoercCat c1 _) (Cat c2) = c1 == c2 -sameCat c1 c2 = c1 == c2 +sameCat = (==) `on` normCat -- | Removes precedence information. C1 => C, [C2] => [C] normCat :: Cat -> Cat @@ -438,6 +415,19 @@ identCat (ListCat c) = "List" ++ identCat c identCat c = catToStr c +identType :: Base -> String +identType (ListT t) = "List" ++ identType t +identType (BaseT s) = s + +-- | Reconstruct (non-coercion) category from a type, given a list of +-- what should be the token categories. +catOfType :: [TokenCat] -> Base -> Cat +catOfType tk = \case + ListT t -> ListCat $ catOfType tk t + BaseT s + | s `elem` tk -> TokenCat s + | otherwise -> Cat s + isList :: Cat -> Bool isList (ListCat _) = True isList _ = False @@ -479,38 +469,46 @@ class IsFun a where funName :: a -> String + isNilFun :: a -> Bool -- ^ Is this the constructor for empty lists? + isOneFun :: a -> Bool -- ^ Is this the constructor for singleton lists? + isConsFun :: a -> Bool -- ^ Is this the list constructor? + isConcatFun :: a -> Bool -- ^ Is this list concatenation? + + -- | Is this function just a coercion? (I.e. the identity) + isCoercion :: a -> Bool + + isNilFun = funNameSatisfies (== "[]") + isOneFun = funNameSatisfies (== "(:[])") + isConsFun = funNameSatisfies (== "(:)") + isConcatFun = funNameSatisfies (== "(++)") + isCoercion = funNameSatisfies (== "_") + instance IsFun String where funName = id instance IsFun a => IsFun (WithPosition a) where funName = funName . wpThing +instance IsFun a => IsFun (Rul a) where + funName = funName . funRule + +instance IsFun a => IsFun (k, a) where + funName = funName . snd + funNameSatisfies :: IsFun a => (String -> Bool) -> a -> Bool funNameSatisfies f = f . funName --- | Is this function just a coercion? (I.e. the identity) -isCoercion :: IsFun a => a -> Bool -isCoercion = funNameSatisfies (== "_") -- perhaps this should be changed to "id"? - isDefinedRule :: IsFun a => a -> Bool isDefinedRule = funNameSatisfies $ \case (x:_) -> isLower x [] -> error "isDefinedRule: empty function name" --- isDefinedRule :: Fun -> Bool --- isDefinedRule (WithPosition _ (x:_)) = isLower x --- isDefinedRule (WithPosition pos []) = error $ --- unwords [ prettyPosition pos, "isDefinedRule: empty function name" ] - +-- not coercion or defined rule isProperLabel :: IsFun a => a -> Bool isProperLabel f = not (isCoercion f || isDefinedRule f) -isNilFun, isOneFun, isConsFun, isNilCons,isConcatFun :: IsFun a => a -> Bool +isNilCons :: IsFun a => a -> Bool isNilCons f = isNilFun f || isOneFun f || isConsFun f || isConcatFun f -isNilFun = funNameSatisfies (== "[]") -isOneFun = funNameSatisfies (== "(:[])") -isConsFun = funNameSatisfies (== "(:)") -isConcatFun = funNameSatisfies (== "(++)") ------------------------------------------------------------------------------ @@ -688,14 +686,16 @@ [(cat, nub (map mkData [r | r <- cfgRules cf, let f = funRule r, not (isDefinedRule f), - not (isCoercion f), sameCat cat (valCat r)])) + not (isCoercion f), cat == normCat (valCat r)])) | cat <- nub $ map normCat $ filter predicate $ reallyAllCats cf ] - where + where mkData (Rule f _ its _) = (wpThing f, [normCat c | Left c <- its ]) +-- translates a grammar to a Data object. cf2data :: CF -> [Data] cf2data = cf2data' $ isDataCat . normCat +-- translates to a Data with List categories included. cf2dataLists :: CF -> [Data] cf2dataLists = cf2data' $ isDataOrListCat . normCat @@ -711,35 +711,24 @@ isParsable :: Rul f -> Bool isParsable = (Parsable ==) . internal +hasNilRule :: [Rule] -> Maybe Rule +hasNilRule = List.find isNilFun --- | Checks if the list has a non-empty rule. -hasOneFunc :: [Rule] -> Bool -hasOneFunc = any (isOneFun . funRule) +-- | Gets the singleton rule out of the rules for a list. +hasSingletonRule :: [Rule] -> Maybe Rule +hasSingletonRule = List.find isOneFun --- | Gets the separator for a list. -getCons :: [Rule] -> String -getCons rs = case find (isConsFun . funRule) rs of - Just (Rule _ _ cats _) -> seper cats - Nothing -> error $ "getCons: no construction function found in " - ++ intercalate ", " (map (show . funRule) rs) - where - seper [] = [] - seper (Right x:_) = x - seper (Left _:xs) = seper xs +-- | Sort rules by descending precedence. --- | Helper function that gets the list separator by precedence level -getSeparatorByPrecedence :: [Rule] -> [(Integer,String)] -getSeparatorByPrecedence rules = [ (p, getCons (getRulesFor p)) | p <- precedences ] - where - precedences = Set.toDescList . Set.fromList $ map precRule rules - getRulesFor p = [ r | r <- rules, precRule r == p ] +sortRulesByPrecedence :: [Rule] -> [(Integer,Rule)] +sortRulesByPrecedence = List.sortOn (Down . fst) . map (precRule &&& id) +-- | Is the given category a list category parsing also empty lists? isEmptyListCat :: CF -> Cat -> Bool -isEmptyListCat cf c = elem "[]" $ map (wpThing . funRule) $ rulesForCat' cf c +isEmptyListCat cf = any isNilFun . rulesForCat' cf isNonterm :: Either Cat String -> Bool -isNonterm (Left _) = True -isNonterm (Right _) = False +isNonterm = Either.isLeft -- used in Happy to parse lists of form 'C t [C]' in reverse order -- applies only if the [] rule has no terminals @@ -749,10 +738,10 @@ -- invariant: test in findAllReversibleCats have been performed findAllReversibleCats :: CF -> [Cat] -findAllReversibleCats cf = [c | (c,r) <- ruleGroups cf, isRev c r] where - isRev c rs = case rs of - [r1,r2] | isList c -> if isConsFun (funRule r2) - then tryRev r2 r1 +findAllReversibleCats cf = [c | (c,r) <- ruleGroups cf, isRev c r] + where + isRev c = \case + [r1,r2] | isList c -> if isConsFun (funRule r2) then tryRev r2 r1 else isConsFun (funRule r1) && tryRev r1 r2 _ -> False tryRev (Rule f _ ts@(x:_:_) _) r = isEmptyNilRule r && @@ -778,6 +767,10 @@ -- Excludes position tokens. hasIdentLikeTokens :: CFG g -> Bool hasIdentLikeTokens cf = hasIdent cf || or [ not b | TokenReg _ b _ <- cfgPragmas cf ] + +-- | Defines or uses the grammar @token@ types or @Ident@? +hasTextualTokens :: CFG g -> Bool +hasTextualTokens cf = hasIdent cf || or [ True | TokenReg{} <- cfgPragmas cf ] -- | Is there a @position token@ declaration in the grammar? hasPositionTokens :: CFG g -> Bool diff --git a/src/BNFC/GetCF.hs b/src/BNFC/GetCF.hs --- a/src/BNFC/GetCF.hs +++ b/src/BNFC/GetCF.hs @@ -52,6 +52,7 @@ import BNFC.CF import BNFC.Check.EmptyTypes import BNFC.Options +import BNFC.PrettyPrint import BNFC.Regex (nullable, simpReg) import BNFC.TypeChecker import BNFC.Utils @@ -70,8 +71,10 @@ >>= return . expandRules >>= getCF opts >>= return . markTokenCategories - either dieUnlessForce return $ runTypeChecker $ checkDefinitions cf + -- Construct the typing information in 'define' expressions. + cf <- either die return $ runTypeChecker $ checkDefinitions cf + -- Some backends do not allow the grammar name to coincide with -- one of the category or constructor names. let names = allNames cf @@ -90,13 +93,24 @@ ] -- Some (most) backends do not support layout. - when (hasLayout cf && target `notElem` + let (layoutTop, layoutKeywords, _) = layoutPragmas cf + let lay = isJust layoutTop || not (null layoutKeywords) + when (lay && target `notElem` [ TargetHaskell, TargetHaskellGadt, TargetLatex, TargetPygments, TargetCheck ]) $ dieUnlessForce $ unwords [ "ERROR: the grammar uses layout, which is not supported by backend" , show target ++ "." ] + -- A grammar that uses layout needs to contain symbols { } ; + let symbols = cfgSymbols cf + layoutSymbols = concat [ [";"], unless (null layoutKeywords) ["{", "}"] ] + missingLayoutSymbols = filter (`notElem` symbols) layoutSymbols + when (lay && not (null missingLayoutSymbols)) $ + dieUnlessForce $ unwords $ + "ERROR: the grammar uses layout, but does not mention" + : map show missingLayoutSymbols + -- Token types that end in a numeral confuse BNFC, because of CoerceCat. let userTokenTypes = [ rx | TokenReg rx _ _ <- cfgPragmas cf ] case filter (isJust . hasNumericSuffix . wpThing) userTokenTypes of @@ -147,7 +161,8 @@ ] -- Warn or fail if the grammar uses names not unique modulo upper/lowercase. - case nub $ filter (`notElem` nonUniqueNames) $ filter (not . isDefinedRule) $ + when False $ + case nub $ filter (`notElem` nonUniqueNames) $ filter (not . isDefinedRule) $ concatMap List1.toList $ duplicatesOn (map toLower . wpThing) names of [] -> return () ns | target `elem` [ TargetJava ] @@ -172,10 +187,7 @@ ] -- Fail if the grammar uses defined constructors which are not actually defined. - let definedConstructor = \case - FunDef x _ _ -> Just x - _ -> Nothing - let definedConstructors = Set.fromList $ mapMaybe definedConstructor $ cfgPragmas cf + let definedConstructors = Set.fromList $ map defName $ definitions cf let undefinedConstructor x = isDefinedRule x && x `Set.notMember` definedConstructors case filter undefinedConstructor $ map funRule $ cfgRules cf of [] -> return () @@ -363,13 +375,13 @@ "The delimiters pragma " ++ removedIn290 Abs.Coercions ident int -> map Right <$> coercionRules ident int Abs.Rules ident strs -> map Right <$> ebnfRules ident strs - Abs.Layout ss -> return [ Left $ Layout ss ] + Abs.Layout ss -> return [ Left $ Layout $ map (,Delimiters ";" "{" "}") ss ] Abs.LayoutStop ss -> return [ Left $ LayoutStop ss] - Abs.LayoutTop -> return [ Left $ LayoutTop ] + Abs.LayoutTop -> return [ Left $ LayoutTop ";" ] Abs.Function ident xs e -> do f <- transIdent ident let xs' = map transArg xs - return [ Left $ FunDef f xs' $ transExp xs' e ] + return [ Left $ FunDef $ Define f xs' (transExp (map fst xs') e) dummyBase ] -- | Translate @separator [nonempty] C "s"@. -- The position attached to the generated rules is taken from @C@. @@ -490,8 +502,8 @@ file <- asks lbnfFile return $ WithPosition (Position file line col) str -transArg :: Abs.Arg -> String -transArg (Abs.Arg (Abs.Identifier (_pos, x))) = x +transArg :: Abs.Arg -> (String, Base) +transArg (Abs.Arg (Abs.Identifier (_pos, x))) = (x, dummyBase) transExp :: [String] -- ^ Arguments of definition (in scope in expression). @@ -500,17 +512,17 @@ transExp xs = loop where loop = \case - Abs.App x es -> App (transIdent' x) (map loop es) + Abs.App x es -> App (transIdent' x) dummyType (map loop es) Abs.Var x -> let x' = transIdent' x in - if x' `elem` xs then Var x' else App x' [] + if x' `elem` xs then Var x' else App x' dummyType [] Abs.Cons e1 e2 -> cons e1 (loop e2) Abs.List es -> foldr cons nil es Abs.LitInt x -> LitInt x Abs.LitDouble x -> LitDouble x Abs.LitChar x -> LitChar x Abs.LitString x -> LitString x - cons e1 e2 = App "(:)" [loop e1, e2] - nil = App "[]" [] + cons e1 e2 = App "(:)" dummyType [loop e1, e2] + nil = App "[]" dummyType [] transIdent' (Abs.Identifier (_pos, x)) = x -------------------------------------------------------------------------------- @@ -542,7 +554,7 @@ -- (2) no other digits are used checkRule :: CF -> Rule -> Maybe String -checkRule cf (Rule f (WithPosition _ cat) rhs _) +checkRule cf r@(Rule f (WithPosition _ cat) rhs _) | Cat ('@':_) <- cat = Nothing -- Generated by a pragma; it's a trusted category | badCoercion = stdFail txtCoercion "Bad coercion in rule" | badNil = stdFail txtNil "Bad empty list rule" @@ -550,7 +562,7 @@ | badCons = stdFail txtCons "Bad list construction rule" | badList = stdFail txtList "Bad list formation rule" | badSpecial = failure $ "Bad special category rule" +++ s - | badTypeName = failure $ "Bad type name" +++ unwords (map show badTypes) +++ "in" +++ s + | badTypeName = failure $ "Bad type name" +++ unwords (map prettyShow badTypes) +++ "in" +++ s | badFunName = failure $ "Bad constructor name" +++ fun +++ "in" +++ s | badMissing = failure $ "no production for" +++ unwords missing ++ ", appearing in rule\n " ++ s | otherwise = Nothing @@ -559,7 +571,7 @@ stdFail txt err = failure $ unlines [ err ++ ":", " " ++ s, txt ] fun = wpThing f - s = fun ++ "." +++ show cat +++ "::=" +++ unwords (map (either show show) rhs) -- Todo: consider using the show instance of Rule + s = prettyShow r c = normCat cat -- lhs cat without the coercion number cs = [normCat c | Left c <- rhs] -- rhs cats without the coercion numbers @@ -581,9 +593,9 @@ badSpecial = elem c [ Cat x | x <- specialCatsP] && not (isCoercion f) badMissing = not (null missing) - missing = filter (`notElem` defineds) [show c | Left c <- rhs] + missing = filter (`notElem` defineds) [catToStr c | Left c <- rhs] where - defineds = tokenNames cf ++ specialCatsP ++ map (show . valCat) (cfgRules cf) + defineds = tokenNames cf ++ specialCatsP ++ map (catToStr . valCat) (cfgRules cf) badTypeName = not (null badTypes) badTypes = filter isBadType $ cat : [c | Left c <- rhs] diff --git a/src/BNFC/Lex.hs b/src/BNFC/Lex.hs new file mode 100644 --- /dev/null +++ b/src/BNFC/Lex.hs @@ -0,0 +1,590 @@ +{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} +{-# LANGUAGE CPP,MagicHash #-} +{-# LINE 3 "BNFC/Lex.x" #-} +{-# OPTIONS -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -w #-} + +{-# LANGUAGE PatternSynonyms #-} + +module BNFC.Lex where + +import Prelude + +import qualified Data.Bits +import Data.Char (ord) +import Data.Function (on) +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 +#else +import Array +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array.Base (unsafeAt) +import GHC.Exts +#else +import GlaExts +#endif +alex_tab_size :: Int +alex_tab_size = 8 +alex_base :: AlexAddr +alex_base = AlexA# + "\xf8\xff\xff\xff\x49\x00\x00\x00\xc9\xff\xff\xff\xe0\xff\xff\xff\xc9\x00\x00\x00\x9c\x01\x00\x00\x2d\x00\x00\x00\x1c\x02\x00\x00\x9c\x02\x00\x00\x1c\x03\x00\x00\x9c\x03\x00\x00\x1c\x04\x00\x00\x9c\x04\x00\x00\x0d\x05\x00\x00\x00\x00\x00\x00\x8d\x05\x00\x00\x00\x00\x00\x00\xfe\x05\x00\x00\x00\x00\x00\x00\x6f\x06\x00\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\xb0\x06\x00\x00\x00\x00\x00\x00\xf1\x06\x00\x00\xf1\x07\x00\x00\xb1\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x08\x00\x00\x22\x09\x00\x00\xe2\x08\x00\x00\x00\x00\x00\x00\xbb\x09\x00\x00\xbb\x0a\x00\x00\xc1\x09\x00\x00\x7b\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x0a\x00\x00\xdb\xff\xff\xff\x47\x00\x00\x00\x72\x00\x00\x00\xb2\x0b\x00\x00\x3d\x0b\x00\x00\x32\x0c\x00\x00\xf2\x0c\x00\x00\xb2\x0c\x00\x00\x00\x00\x00\x00\xa8\x0d\x00\x00\x00\x00\x00\x00\x78\x00\x00\x00\xdc\xff\xff\xff\xdd\xff\xff\xff\x00\x00\x00\x00\xdf\xff\xff\xff\x81\x0e\x00\x00\xe4\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x00\x00\x00\xb9\x09\x00\x00\x8c\x00\x00\x00"# + +alex_table :: AlexAddr +alex_table = AlexA# + "\x00\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x37\x00\x3c\x00\x2b\x00\x32\x00\x05\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x34\x00\x02\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x35\x00\x37\x00\x00\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x38\x00\x37\x00\x00\x00\x37\x00\x00\x00\x37\x00\x00\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x37\x00\x03\x00\x37\x00\x00\x00\x37\x00\x00\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x36\x00\x37\x00\x37\x00\x01\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x03\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x2a\x00\x00\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x33\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1b\x00\x0a\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x0f\x00\x0e\x00\x0e\x00\x0e\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x01\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1b\x00\x0a\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x0f\x00\x0e\x00\x0e\x00\x0e\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x04\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x23\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x1f\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x1a\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x08\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x09\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x15\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\x0a\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x17\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\x19\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\x20\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\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1f\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x20\x00\x09\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x17\x00\x0c\x00\x10\x00\x10\x00\x10\x00\x11\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\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\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3b\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x00\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x25\x00\x08\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x19\x00\x0b\x00\x12\x00\x12\x00\x12\x00\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x00\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x00\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x30\x00\x04\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x28\x00\x07\x00\x1d\x00\x1d\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x2e\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +alex_check :: AlexAddr +alex_check = AlexA# + "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3d\x00\x27\x00\x2d\x00\x2d\x00\x2d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x20\x00\x3a\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x27\x00\x5d\x00\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x2d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\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\xff\xff\xc3\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x7d\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x27\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x0a\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\x22\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\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\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\x5c\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\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_deflt :: AlexAddr +alex_deflt = AlexA# + "\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x14\x00\xff\xff\x16\x00\x16\x00\x18\x00\x18\x00\x1c\x00\x1c\x00\x21\x00\x21\x00\x26\x00\x26\x00\x05\x00\x05\x00\x05\x00\x27\x00\x27\x00\x03\x00\x03\x00\x03\x00\x03\x00\x2c\x00\xff\xff\x2c\x00\x2c\x00\x31\x00\x31\x00\xff\xff\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x32\x00\x32\x00\x32\x00\x32\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"# + +alex_accept = listArray (0 :: Int, 63) + [ AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccSkip + , AlexAccSkip + , AlexAccSkip + , AlexAcc 10 + , AlexAcc 9 + , AlexAcc 8 + , AlexAcc 7 + , AlexAcc 6 + , AlexAcc 5 + , AlexAcc 4 + , AlexAcc 3 + , AlexAcc 2 + , AlexAcc 1 + , AlexAcc 0 + ] + +alex_actions = array (0 :: Int, 11) + [ (10,alex_action_3) + , (9,alex_action_3) + , (8,alex_action_3) + , (7,alex_action_3) + , (6,alex_action_4) + , (5,alex_action_5) + , (4,alex_action_6) + , (3,alex_action_7) + , (2,alex_action_8) + , (1,alex_action_9) + , (0,alex_action_9) + ] + +{-# LINE 71 "BNFC/Lex.x" #-} +-- | 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. + | T_Identifier !String + 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) + +-- | Keyword/symbol equality is determined by the unique ID. +instance Eq TokSymbol where (==) = (==) `on` tsID + +-- | Keyword/symbol ordering is determined by the unique ID. +instance Ord TokSymbol where compare = compare `on` tsID + +-- | Token with position. +data Token + = PT Posn Tok + | Err Posn + deriving (Eq, Show, Ord) + +-- | Pretty print a position. +printPosn :: Posn -> String +printPosn (Pn _ l c) = "line " ++ show l ++ ", column " ++ show c + +-- | Pretty print the position of the first token in the list. +tokenPos :: [Token] -> String +tokenPos (t:_) = printPosn (tokenPosn t) +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) +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) + +-- | Convert a token to its text. +tokenText :: Token -> String +tokenText t = case t of + PT _ (TS s _) -> s + PT _ (TL s) -> show s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + Err _ -> "#error" + PT _ (T_Identifier s) -> s + +-- | 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) + +-- | 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 + +-- | The keywords and symbols of the language organized as binary search tree. +resWords :: BTree +resWords = + b "delimiters" 20 + (b ";" 10 + (b "," 5 + (b "*" 3 (b ")" 2 (b "(" 1 N N) N) (b "+" 4 N N)) + (b ":" 8 (b "." 7 (b "-" 6 N N) N) (b "::=" 9 N N))) + (b "_" 15 + (b "[" 13 (b "?" 12 (b "=" 11 N N) N) (b "]" 14 N N)) + (b "comment" 18 + (b "coercions" 17 (b "char" 16 N N) N) (b "define" 19 N N)))) + (b "rules" 30 + (b "layout" 25 + (b "eps" 23 + (b "entrypoints" 22 (b "digit" 21 N N) N) (b "internal" 24 N N)) + (b "nonempty" 28 + (b "lower" 27 (b "letter" 26 N N) N) (b "position" 29 N N))) + (b "toplevel" 35 + (b "terminator" 33 + (b "stop" 32 (b "separator" 31 N N) N) (b "token" 34 N N)) + (b "|" 38 (b "{" 37 (b "upper" 36 N N) N) (b "}" 39 N N)))) + where + b s n = B bs (TS bs n) + where + bs = s + +-- | Unquote string literal. +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 + '\\':'r':cs -> '\r' : unesc cs + '\\':'f':cs -> '\f' : 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 (eitherResIdent TV) +alex_action_4 = tok (eitherResIdent T_Identifier) +alex_action_5 = tok (eitherResIdent TV) +alex_action_6 = tok (TL . unescapeInitTail) +alex_action_7 = tok TC +alex_action_8 = tok TI +alex_action_9 = tok TD + +{-# 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 + + + + + + + + + + + + + + + + + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define GTE(n,m) (tagToEnum# (n >=# m)) +#define EQ(n,m) (tagToEnum# (n ==# m)) +#else +#define GTE(n,m) (n >=# m) +#define EQ(n,m) (n ==# m) +#endif + + + + + + + + + + + + + + + + + + + +data AlexAddr = AlexA# Addr# +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ < 503 +uncheckedShiftL# = shiftL# +#endif + +{-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow16Int# i + where + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# +#else + indexInt16OffAddr# arr off +#endif + + + + + +{-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow32Int# i + where + i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + (b2 `uncheckedShiftL#` 16#) `or#` + (b1 `uncheckedShiftL#` 8#) `or#` b0) + b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) + b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) + b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + b0 = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 4# +#else + indexInt32OffAddr# arr off +#endif + + + + + + +#if __GLASGOW_HASKELL__ < 503 +quickIndex arr i = arr ! i +#else +-- GHC >= 503, unsafeAt is available from Data.Array.Base. +quickIndex = unsafeAt +#endif + + + + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> AlexReturn a +alexScan input__ (I# (sc)) + = alexScanUser undefined input__ (I# (sc)) + +alexScanUser user__ input__ (I# (sc)) + = case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of + (AlexNone, input__') -> + case alexGetByte input__ of + Nothing -> + + + + AlexEOF + Just _ -> + + + + AlexError input__' + + (AlexLastSkip input__'' len, _) -> + + + + AlexSkip input__'' len + + (AlexLastAcc k input__''' len, _) -> + + + + AlexToken input__''' len (alex_actions ! k) + + +-- Push the input through the DFA, remembering the most recent accepting +-- state it encountered. + +alex_scan_tkn user__ orig_input len input__ s last_acc = + input__ `seq` -- strict in the input + let + new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) + in + new_acc `seq` + case alexGetByte input__ of + Nothing -> (new_acc, input__) + Just (c, new_input) -> + + + + case fromIntegral c of { (I# (ord_c)) -> + let + base = alexIndexInt32OffAddr alex_base s + offset = (base +# ord_c) + check = alexIndexInt16OffAddr alex_check offset + + new_s = if GTE(offset,0#) && EQ(check,ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + case new_s of + -1# -> (new_acc, input__) + -- on an error, we want to keep the input *before* the + -- character that failed, not after. + _ -> alex_scan_tkn user__ orig_input + + + + + (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) + -- note that the length is increased ONLY if this is the 1st byte in a char encoding) + + new_input new_s new_acc + } + where + check_accs (AlexAccNone) = last_acc + check_accs (AlexAcc a ) = AlexLastAcc a input__ (I# (len)) + check_accs (AlexAccSkip) = AlexLastSkip input__ (I# (len)) + + + + + + + + + + + + + +data AlexLastAcc + = AlexNone + | AlexLastAcc !Int !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc user + = AlexAccNone + | AlexAcc Int + | AlexAccSkip + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/BNFC/Lex.x b/src/BNFC/Lex.x --- a/src/BNFC/Lex.x +++ b/src/BNFC/Lex.x @@ -3,13 +3,20 @@ { {-# OPTIONS -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -w #-} + +{-# LANGUAGE PatternSynonyms #-} + module BNFC.Lex where +import Prelude + import qualified Data.Bits -import Data.Word (Word8) -import Data.Char (ord) +import Data.Char (ord) +import Data.Function (on) +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 @@ -18,75 +25,116 @@ $i = [$l $d _ '] -- identifier character $u = [. \n] -- universal: any character -@rsyms = -- symbols and non-identifier-like reserved words - \; | \. | \: \: \= | \[ | \] | \, | \_ | \( | \: | \) | \= | \| | \- | \* | \+ | \? | \{ | \} +-- Symbols and non-identifier-like reserved words +@rsyms = \; | \. | \: \: \= | \[ | \] | \, | \_ | \( | \: | \) | \= | \| | \- | \* | \+ | \? | \{ | \} + :- --- Line comments +-- Line comment "--" "--" [.]* ; --- Block comments +-- Block comment "{-" "-}" \{ \- [$u # \-]* \- ([$u # [\- \}]] [$u # \-]* \- | \-)* \} ; +-- Whitespace (skipped) $white+ ; + +-- Symbols @rsyms - { tok (\p s -> PT p (eitherResIdent TV s)) } + { tok (eitherResIdent TV) } + +-- token Identifier $l (\_ | ($d | $l)) * - { tok (\p s -> PT p (eitherResIdent T_Identifier s)) } + { tok (eitherResIdent T_Identifier) } +-- Keywords and Ident $l $i* - { tok (\p s -> PT p (eitherResIdent TV s)) } + { tok (eitherResIdent TV) } + +-- String \" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t | r | f)))* \" - { tok (\p s -> PT p (TL $ unescapeInitTail s)) } + { tok (TL . unescapeInitTail) } + +-- Char \' ($u # [\' \\] | \\ [\\ \' n t r f]) \' - { tok (\p s -> PT p (TC s)) } + { tok TC } + +-- Integer $d+ - { tok (\p s -> PT p (TI s)) } + { tok TI } + +-- Double $d+ \. $d+ (e (\-)? $d+)? - { tok (\p s -> PT p (TD s)) } + { tok TD } { +-- | Create a token with position. +tok :: (String -> Tok) -> (Posn -> String -> Token) +tok f p = PT p . f -tok :: (Posn -> String -> Token) -> (Posn -> String -> Token) -tok f p s = f p s +-- | 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. + | T_Identifier !String + deriving (Eq, Show, Ord) -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 - | T_Identifier !String +-- | Smart constructor for 'Tok' for the sake of backwards compatibility. +pattern TS :: String -> Int -> Tok +pattern TS t i = TK (TokSymbol t i) - deriving (Eq,Show,Ord) +-- | Keyword or symbol tokens have a unique ID. +data TokSymbol = TokSymbol + { tsText :: String + -- ^ Keyword or symbol text. + , tsID :: !Int + -- ^ Unique ID. + } deriving (Show) -data Token = - PT Posn Tok - | Err Posn - deriving (Eq,Show,Ord) +-- | Keyword/symbol equality is determined by the unique ID. +instance Eq TokSymbol where (==) = (==) `on` tsID +-- | Keyword/symbol ordering is determined by the unique ID. +instance Ord TokSymbol where compare = compare `on` tsID + +-- | Token with position. +data Token + = PT Posn Tok + | Err Posn + deriving (Eq, Show, Ord) + +-- | Pretty print a position. printPosn :: Posn -> String printPosn (Pn _ l c) = "line " ++ show l ++ ", column " ++ show c +-- | Pretty print the position of the first token in the list. tokenPos :: [Token] -> String tokenPos (t:_) = printPosn (tokenPosn t) -tokenPos [] = "end of file" +tokenPos [] = "end of file" +-- | Get the position of a token. tokenPosn :: Token -> Posn tokenPosn (PT p _) = p -tokenPosn (Err p) = p +tokenPosn (Err p) = p +-- | Get line and column of a token. tokenLineCol :: Token -> (Int, Int) 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@(PT p _) = (posLineCol p, tokenText t) +mkPosToken t = (tokenLineCol t, tokenText t) +-- | Convert a token to its text. tokenText :: Token -> String tokenText t = case t of PT _ (TS s _) -> s @@ -98,24 +146,56 @@ Err _ -> "#error" PT _ (T_Identifier s) -> s +-- | Convert a token to a string. prToken :: Token -> String prToken t = tokenText t -data BTree = N | B String Tok BTree BTree deriving (Show) +-- | 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) +-- | 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) | s < a = treeFind left - | s > a = treeFind right - | s == a = t + treeFind (B a t left right) = + case compare s a of + LT -> treeFind left + GT -> treeFind right + EQ -> t +-- | The keywords and symbols of the language organized as binary search tree. resWords :: BTree -resWords = b "delimiters" 20 (b ";" 10 (b "," 5 (b "*" 3 (b ")" 2 (b "(" 1 N N) N) (b "+" 4 N N)) (b ":" 8 (b "." 7 (b "-" 6 N N) N) (b "::=" 9 N N))) (b "_" 15 (b "[" 13 (b "?" 12 (b "=" 11 N N) N) (b "]" 14 N N)) (b "comment" 18 (b "coercions" 17 (b "char" 16 N N) N) (b "define" 19 N N)))) (b "rules" 30 (b "layout" 25 (b "eps" 23 (b "entrypoints" 22 (b "digit" 21 N N) N) (b "internal" 24 N N)) (b "nonempty" 28 (b "lower" 27 (b "letter" 26 N N) N) (b "position" 29 N N))) (b "toplevel" 35 (b "terminator" 33 (b "stop" 32 (b "separator" 31 N N) N) (b "token" 34 N N)) (b "|" 38 (b "{" 37 (b "upper" 36 N N) N) (b "}" 39 N N)))) - where b s n = let bs = s - in B bs (TS bs n) +resWords = + b "delimiters" 20 + (b ";" 10 + (b "," 5 + (b "*" 3 (b ")" 2 (b "(" 1 N N) N) (b "+" 4 N N)) + (b ":" 8 (b "." 7 (b "-" 6 N N) N) (b "::=" 9 N N))) + (b "_" 15 + (b "[" 13 (b "?" 12 (b "=" 11 N N) N) (b "]" 14 N N)) + (b "comment" 18 + (b "coercions" 17 (b "char" 16 N N) N) (b "define" 19 N N)))) + (b "rules" 30 + (b "layout" 25 + (b "eps" 23 + (b "entrypoints" 22 (b "digit" 21 N N) N) (b "internal" 24 N N)) + (b "nonempty" 28 + (b "lower" 27 (b "letter" 26 N N) N) (b "position" 29 N N))) + (b "toplevel" 35 + (b "terminator" 33 + (b "stop" 32 (b "separator" 31 N N) N) (b "token" 34 N N)) + (b "|" 38 (b "{" 37 (b "upper" 36 N N) N) (b "}" 39 N N)))) + where + b s n = B bs (TS bs n) + where + bs = s +-- | Unquote string literal. unescapeInitTail :: String -> String unescapeInitTail = id . unesc . tail . id where @@ -125,9 +205,9 @@ '\\':'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. @@ -135,7 +215,7 @@ ------------------------------------------------------------------- data Posn = Pn !Int !Int !Int - deriving (Eq, Show,Ord) + deriving (Eq, Show, Ord) alexStartPos :: Posn alexStartPos = Pn 0 1 1 @@ -179,7 +259,7 @@ -- | 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/BNFC/Options.hs b/src/BNFC/Options.hs --- a/src/BNFC/Options.hs +++ b/src/BNFC/Options.hs @@ -11,6 +11,7 @@ , defaultOptions, isDefault, printOptions , AlexVersion(..), HappyMode(..), OCamlParser(..), JavaLexerParser(..) , RecordPositions(..), TokenText(..) + , InPackage , removedIn290 , translateOldOptions ) @@ -95,6 +96,9 @@ data RecordPositions = RecordPositions | NoRecordPositions deriving (Eq,Show,Ord) +-- | Package name (C++ and Java backends). +type InPackage = Maybe String + -- | How to represent token content in the Haskell backend? data TokenText @@ -112,7 +116,7 @@ , force :: Bool -- ^ Ignore errors as much as possible? , target :: Target -- ^ E.g. @--haskell@. , make :: Maybe String -- ^ The name of the Makefile to generate or Nothing for no Makefile. - , inPackage :: Maybe String -- ^ The hierarchical package to put the modules in, or Nothing. + , inPackage :: InPackage -- ^ The hierarchical package to put the modules in, or Nothing. , linenumbers :: RecordPositions -- ^ Add and set line_number field for syntax classes --- Haskell specific: , inDir :: Bool -- ^ Option @-d@. @@ -336,7 +340,7 @@ -- "Use Alex 3 as Haskell lexer tool (default)" -- , haskellTargets ) , ( Option [] ["bytestrings"] (NoArg (\o -> o { tokenText = ByteStringToken })) - "Use ByteString in Alex lexer" + "Use ByteString in Alex lexer [deprecated, use --text-token]" , haskellTargets ) , ( Option [] ["text-token"] (NoArg (\o -> o { tokenText = TextToken })) "Use Text in Alex lexer" @@ -620,8 +624,8 @@ , ("-alex1" , "--alex1") , ("-alex2" , "--alex2") , ("-alex3" , "--alex3") - , ("-sharestrings" , "--sharestring") - , ("-bytestrings" , "--bytestring") + , ("-sharestrings" , "--sharestrings") + , ("-bytestrings" , "--bytestrings") , ("-glr" , "--glr") , ("-xml" , "--xml") , ("-xmlt" , "--xmlt") diff --git a/src/BNFC/Par.hs b/src/BNFC/Par.hs new file mode 100644 --- /dev/null +++ b/src/BNFC/Par.hs @@ -0,0 +1,1604 @@ +{-# OPTIONS_GHC -w #-} +{-# OPTIONS -XMagicHash -XBangPatterns -XTypeSynonymInstances -XFlexibleInstances -cpp #-} +#if __GLASGOW_HASKELL__ >= 710 +{-# OPTIONS_GHC -XPartialTypeSignatures #-} +#endif +{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +{-# LANGUAGE PatternSynonyms #-} + +module BNFC.Par + ( happyError + , myLexer + , pGrammar + , pListDef + , pDef + , pItem + , pListItem + , pCat + , pListCat + , pLabel + , pArg + , pListArg + , pSeparation + , pListString + , pExp + , pExp1 + , pExp2 + , pListExp + , pListExp2 + , pRHS + , pListRHS + , pMinimumSize + , pReg + , pReg1 + , pReg2 + , pReg3 + ) where + +import Prelude + +import qualified BNFC.Abs +import BNFC.Lex +import qualified Data.Array as Happy_Data_Array +import qualified Data.Bits as Bits +import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) + +-- parser produced by Happy Version 1.20.0 + +newtype HappyAbsSyn = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +newtype HappyWrap27 = HappyWrap27 (Char) +happyIn27 :: (Char) -> (HappyAbsSyn ) +happyIn27 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap27 x) +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn ) -> HappyWrap27 +happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut27 #-} +newtype HappyWrap28 = HappyWrap28 (Double) +happyIn28 :: (Double) -> (HappyAbsSyn ) +happyIn28 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap28 x) +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn ) -> HappyWrap28 +happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut28 #-} +newtype HappyWrap29 = HappyWrap29 (Integer) +happyIn29 :: (Integer) -> (HappyAbsSyn ) +happyIn29 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap29 x) +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn ) -> HappyWrap29 +happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut29 #-} +newtype HappyWrap30 = HappyWrap30 (String) +happyIn30 :: (String) -> (HappyAbsSyn ) +happyIn30 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap30 x) +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn ) -> HappyWrap30 +happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut30 #-} +newtype HappyWrap31 = HappyWrap31 (BNFC.Abs.Identifier) +happyIn31 :: (BNFC.Abs.Identifier) -> (HappyAbsSyn ) +happyIn31 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap31 x) +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn ) -> HappyWrap31 +happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut31 #-} +newtype HappyWrap32 = HappyWrap32 (BNFC.Abs.Grammar) +happyIn32 :: (BNFC.Abs.Grammar) -> (HappyAbsSyn ) +happyIn32 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap32 x) +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn ) -> HappyWrap32 +happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut32 #-} +newtype HappyWrap33 = HappyWrap33 ([BNFC.Abs.Def]) +happyIn33 :: ([BNFC.Abs.Def]) -> (HappyAbsSyn ) +happyIn33 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap33 x) +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn ) -> HappyWrap33 +happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut33 #-} +newtype HappyWrap34 = HappyWrap34 (BNFC.Abs.Def) +happyIn34 :: (BNFC.Abs.Def) -> (HappyAbsSyn ) +happyIn34 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap34 x) +{-# INLINE happyIn34 #-} +happyOut34 :: (HappyAbsSyn ) -> HappyWrap34 +happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut34 #-} +newtype HappyWrap35 = HappyWrap35 (BNFC.Abs.Item) +happyIn35 :: (BNFC.Abs.Item) -> (HappyAbsSyn ) +happyIn35 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap35 x) +{-# INLINE happyIn35 #-} +happyOut35 :: (HappyAbsSyn ) -> HappyWrap35 +happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut35 #-} +newtype HappyWrap36 = HappyWrap36 ([BNFC.Abs.Item]) +happyIn36 :: ([BNFC.Abs.Item]) -> (HappyAbsSyn ) +happyIn36 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap36 x) +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn ) -> HappyWrap36 +happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut36 #-} +newtype HappyWrap37 = HappyWrap37 (BNFC.Abs.Cat) +happyIn37 :: (BNFC.Abs.Cat) -> (HappyAbsSyn ) +happyIn37 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap37 x) +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn ) -> HappyWrap37 +happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut37 #-} +newtype HappyWrap38 = HappyWrap38 ([BNFC.Abs.Cat]) +happyIn38 :: ([BNFC.Abs.Cat]) -> (HappyAbsSyn ) +happyIn38 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap38 x) +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn ) -> HappyWrap38 +happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut38 #-} +newtype HappyWrap39 = HappyWrap39 (BNFC.Abs.Label) +happyIn39 :: (BNFC.Abs.Label) -> (HappyAbsSyn ) +happyIn39 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap39 x) +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn ) -> HappyWrap39 +happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut39 #-} +newtype HappyWrap40 = HappyWrap40 (BNFC.Abs.Arg) +happyIn40 :: (BNFC.Abs.Arg) -> (HappyAbsSyn ) +happyIn40 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap40 x) +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn ) -> HappyWrap40 +happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut40 #-} +newtype HappyWrap41 = HappyWrap41 ([BNFC.Abs.Arg]) +happyIn41 :: ([BNFC.Abs.Arg]) -> (HappyAbsSyn ) +happyIn41 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap41 x) +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn ) -> HappyWrap41 +happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut41 #-} +newtype HappyWrap42 = HappyWrap42 (BNFC.Abs.Separation) +happyIn42 :: (BNFC.Abs.Separation) -> (HappyAbsSyn ) +happyIn42 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap42 x) +{-# INLINE happyIn42 #-} +happyOut42 :: (HappyAbsSyn ) -> HappyWrap42 +happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut42 #-} +newtype HappyWrap43 = HappyWrap43 ([String]) +happyIn43 :: ([String]) -> (HappyAbsSyn ) +happyIn43 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap43 x) +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn ) -> HappyWrap43 +happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut43 #-} +newtype HappyWrap44 = HappyWrap44 (BNFC.Abs.Exp) +happyIn44 :: (BNFC.Abs.Exp) -> (HappyAbsSyn ) +happyIn44 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap44 x) +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn ) -> HappyWrap44 +happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut44 #-} +newtype HappyWrap45 = HappyWrap45 (BNFC.Abs.Exp) +happyIn45 :: (BNFC.Abs.Exp) -> (HappyAbsSyn ) +happyIn45 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap45 x) +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn ) -> HappyWrap45 +happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut45 #-} +newtype HappyWrap46 = HappyWrap46 (BNFC.Abs.Exp) +happyIn46 :: (BNFC.Abs.Exp) -> (HappyAbsSyn ) +happyIn46 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap46 x) +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn ) -> HappyWrap46 +happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut46 #-} +newtype HappyWrap47 = HappyWrap47 ([BNFC.Abs.Exp]) +happyIn47 :: ([BNFC.Abs.Exp]) -> (HappyAbsSyn ) +happyIn47 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap47 x) +{-# INLINE happyIn47 #-} +happyOut47 :: (HappyAbsSyn ) -> HappyWrap47 +happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut47 #-} +newtype HappyWrap48 = HappyWrap48 ([BNFC.Abs.Exp]) +happyIn48 :: ([BNFC.Abs.Exp]) -> (HappyAbsSyn ) +happyIn48 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap48 x) +{-# INLINE happyIn48 #-} +happyOut48 :: (HappyAbsSyn ) -> HappyWrap48 +happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut48 #-} +newtype HappyWrap49 = HappyWrap49 (BNFC.Abs.RHS) +happyIn49 :: (BNFC.Abs.RHS) -> (HappyAbsSyn ) +happyIn49 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap49 x) +{-# INLINE happyIn49 #-} +happyOut49 :: (HappyAbsSyn ) -> HappyWrap49 +happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut49 #-} +newtype HappyWrap50 = HappyWrap50 ([BNFC.Abs.RHS]) +happyIn50 :: ([BNFC.Abs.RHS]) -> (HappyAbsSyn ) +happyIn50 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap50 x) +{-# INLINE happyIn50 #-} +happyOut50 :: (HappyAbsSyn ) -> HappyWrap50 +happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut50 #-} +newtype HappyWrap51 = HappyWrap51 (BNFC.Abs.MinimumSize) +happyIn51 :: (BNFC.Abs.MinimumSize) -> (HappyAbsSyn ) +happyIn51 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap51 x) +{-# INLINE happyIn51 #-} +happyOut51 :: (HappyAbsSyn ) -> HappyWrap51 +happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut51 #-} +newtype HappyWrap52 = HappyWrap52 (BNFC.Abs.Reg) +happyIn52 :: (BNFC.Abs.Reg) -> (HappyAbsSyn ) +happyIn52 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap52 x) +{-# INLINE happyIn52 #-} +happyOut52 :: (HappyAbsSyn ) -> HappyWrap52 +happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut52 #-} +newtype HappyWrap53 = HappyWrap53 (BNFC.Abs.Reg) +happyIn53 :: (BNFC.Abs.Reg) -> (HappyAbsSyn ) +happyIn53 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap53 x) +{-# INLINE happyIn53 #-} +happyOut53 :: (HappyAbsSyn ) -> HappyWrap53 +happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut53 #-} +newtype HappyWrap54 = HappyWrap54 (BNFC.Abs.Reg) +happyIn54 :: (BNFC.Abs.Reg) -> (HappyAbsSyn ) +happyIn54 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap54 x) +{-# INLINE happyIn54 #-} +happyOut54 :: (HappyAbsSyn ) -> HappyWrap54 +happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut54 #-} +newtype HappyWrap55 = HappyWrap55 (BNFC.Abs.Reg) +happyIn55 :: (BNFC.Abs.Reg) -> (HappyAbsSyn ) +happyIn55 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap55 x) +{-# INLINE happyIn55 #-} +happyOut55 :: (HappyAbsSyn ) -> HappyWrap55 +happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut55 #-} +happyInTok :: (Token) -> (HappyAbsSyn ) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> (Token) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyExpList :: HappyAddr +happyExpList = HappyA# "\x00\x00\x00\x00\x00\x00\x80\x00\xa9\xd7\xb8\x01\x04\x00\x00\x00\x00\x00\x00\x08\x90\x7a\x8d\x1b\x40\x00\x00\x00\x00\x00\x00\x80\x00\xa8\xd7\xb8\x01\x04\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x08\x80\x02\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x80\x00\x08\x00\x00\xc0\x07\x00\x00\x00\x00\x00\x00\x08\x80\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x00\x80\x00\x08\x00\x00\xc0\x07\x00\x00\x00\x00\x00\x00\x08\x80\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x00\x80\x00\x08\x00\x00\xc0\x07\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x48\x28\x03\x4c\x00\x00\x00\x00\x00\x00\x00\x08\x80\x84\x32\xc0\x04\x00\x00\x00\x00\x00\x00\x80\x00\x48\x28\x03\x4c\x00\x00\x00\x00\x00\x00\x00\x08\x80\x84\x32\xc0\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x48\x28\x03\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x08\x80\x84\x32\xc0\x04\x00\x00\x00\x00\x00\x00\x00\x06\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x48\x28\x03\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\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\x80\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x80\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x80\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x00\x80\x00\x08\x00\x00\xc0\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x80\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\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\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x08\x80\x02\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x02\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\xa9\xd7\xb8\x01\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\xa9\xd7\xb8\x01\x04\x00\x00\x00\x00\x00\x00\x08\x80\x84\x32\xc0\x04\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x08\x80\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x00\x80\x00\x08\x00\x00\xc0\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x48\x28\x03\x4c\x00\x00\x00\x00\x00\x00\x00\x08\x80\x84\x32\xc0\x04\x00\x00\x00\x00\x00\x00\x00\x06\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\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\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x80\x84\x32\xc0\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x80\x84\x32\xc0\x04\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x08\x80\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x06\x00\x00\x00\x00\x00\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\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +{-# NOINLINE happyExpListPerState #-} +happyExpListPerState st = + token_strs_expected + where token_strs = ["error","%dummy","%start_pGrammar","%start_pListDef","%start_pDef","%start_pItem","%start_pListItem","%start_pCat","%start_pListCat","%start_pLabel","%start_pArg","%start_pListArg","%start_pSeparation","%start_pListString","%start_pExp","%start_pExp1","%start_pExp2","%start_pListExp","%start_pListExp2","%start_pRHS","%start_pListRHS","%start_pMinimumSize","%start_pReg","%start_pReg1","%start_pReg2","%start_pReg3","Char","Double","Integer","String","Identifier","Grammar","ListDef","Def","Item","ListItem","Cat","ListCat","Label","Arg","ListArg","Separation","ListString","Exp","Exp1","Exp2","ListExp","ListExp2","RHS","ListRHS","MinimumSize","Reg","Reg1","Reg2","Reg3","'('","')'","'*'","'+'","','","'-'","'.'","':'","'::='","';'","'='","'?'","'['","']'","'_'","'char'","'coercions'","'comment'","'define'","'delimiters'","'digit'","'entrypoints'","'eps'","'internal'","'layout'","'letter'","'lower'","'nonempty'","'position'","'rules'","'separator'","'stop'","'terminator'","'token'","'toplevel'","'upper'","'{'","'|'","'}'","L_charac","L_doubl","L_integ","L_quoted","L_Identifier","%eof"] + bit_start = st Prelude.* 100 + bit_end = (st Prelude.+ 1) Prelude.* 100 + read_bit = readArrayBit happyExpList + bits = Prelude.map read_bit [bit_start..bit_end Prelude.- 1] + bits_indexed = Prelude.zip bits [0..99] + token_strs_expected = Prelude.concatMap f bits_indexed + f (Prelude.False, _) = [] + f (Prelude.True, nr) = [token_strs Prelude.!! nr] + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x1e\x00\x1e\x00\x40\x00\xf6\xff\xf6\xff\xf4\xff\xf4\xff\x2b\x00\x18\x00\x18\x00\x2f\x00\xe0\xff\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\xf6\xff\xf6\xff\x4c\x00\x59\x00\x59\x00\x59\x00\x59\x00\x45\x00\x00\x00\x00\x00\x06\x00\x59\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x46\x00\x01\x00\xb6\x00\x11\x00\x59\x00\xdf\xff\x7a\x00\x55\x00\x00\x00\x00\x00\x00\x00\xf6\xff\x00\x00\x00\x00\x61\x00\x74\x00\xf4\xff\x00\x00\x00\x00\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x74\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x1d\x00\x9e\x00\xb0\x00\x00\x00\x79\x00\x79\x00\x79\x00\x79\x00\xba\x00\xa1\x00\xa1\x00\xac\x00\xac\x00\x00\x00\xb5\x00\xaf\x00\xaf\x00\x00\x00\xaf\x00\xd6\x00\xda\x00\x00\x00\xfb\x00\xe7\x00\xe7\x00\xe7\x00\xe7\x00\xe7\x00\xef\x00\xe9\x00\xfe\x00\x07\x01\xf4\xff\xf4\xff\x2b\x00\x85\x00\x1d\x01\x1b\x01\x36\x01\x36\x01\x30\x01\x31\x01\x67\x01\x1e\x00\x46\x01\x00\x00\x00\x00\x1e\x00\x59\x00\xf4\xff\xf4\xff\x69\x01\x48\x01\x00\x00\x4a\x01\x00\x00\x6f\x01\x00\x00\x4c\x01\x4e\x01\x51\x01\x4f\x01\xf4\xff\xf4\xff\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x52\x01\x1d\x00\x1d\x00\x00\x00\x6a\x01\x79\x01\x00\x00\x70\x01\xf6\xff\x00\x00\x59\x00\x59\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x58\x01\x72\x01\x13\x00\x00\x00\x00\x00\x00\x00\x7b\x01\x59\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x00\x00\x7a\x01\x00\x00\x00\x00\x7c\x01\x5a\x01\xf4\xff\x00\x00\x59\x00\xf6\xff\x5a\x01\x5a\x01\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x01\x7d\x01\x2f\x00\x1d\x00\xf6\xff\x86\x01\x00\x00\x00\x00\x00\x00\x6d\x01\xf6\xff\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\xf5\x00\x24\x01\x35\x01\x50\x01\x3a\x01\x2a\x01\x55\x01\x5f\x00\x48\x00\x57\x00\x7e\x01\x03\x00\xec\x00\x0f\x01\x23\x01\xaa\x00\x8f\x00\x16\x01\xc9\x00\x73\x01\x5c\x00\x72\x00\x08\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x87\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x01\x4b\x00\x00\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x01\x00\x00\x00\x00\x00\x00\x00\x00\x61\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x94\x00\x00\x00\xf1\x00\xb2\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\x01\x8c\x01\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x01\x8f\x01\x90\x01\x62\x01\x57\x01\x29\x01\x04\x00\x00\x00\x91\x01\x78\x01\x7f\x01\x92\x01\x00\x00\x00\x00\x2b\x01\x00\x00\x00\x00\x00\x00\x34\x01\x6a\x00\x63\x01\x64\x01\x00\x00\x94\x01\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x96\x01\xd9\x00\x97\x01\x99\x01\x65\x01\x59\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x05\x01\xc7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\x00\x00\x00\x27\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9a\x01\x66\x01\x00\x00\x6f\x00\xe1\x00\x9b\x01\x9c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x01\x0a\x01\x45\x01\x00\x00\x00\x00\x00\x00\x00\x00\x88\x01\x4d\x01\x00\x00\x00\x00\x00\x00"# + +happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# +happyAdjustOffset off = off + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xe1\xff\xe1\xff\x00\x00\x00\x00\xcb\xff\x00\x00\xc7\xff\x00\x00\x00\x00\xbe\xff\xbc\xff\x00\x00\x00\x00\x00\x00\x00\x00\xac\xff\x00\x00\xcb\xff\xcb\xff\xa3\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe7\xff\x98\xff\x00\x00\x00\x00\x00\x00\x91\xff\x95\xff\x99\xff\x94\xff\x92\xff\x93\xff\x00\x00\x00\x00\x9d\xff\x00\x00\x9f\xff\x00\x00\xa1\xff\x00\x00\xa4\xff\xcd\xff\xc8\xff\xcb\xff\xa7\xff\xcc\xff\xa6\xff\x00\x00\x00\x00\xe4\xff\xe3\xff\x00\x00\xb1\xff\xaf\xff\xb2\xff\xb0\xff\xb3\xff\xa9\xff\x00\x00\x00\x00\xac\xff\xe6\xff\xe5\xff\xb3\xff\xab\xff\xb6\xff\xb4\xff\x00\x00\x00\x00\x00\x00\x00\x00\xb9\xff\x00\x00\x00\x00\x00\x00\x00\x00\xbf\xff\xbe\xff\x00\x00\x00\x00\xc4\xff\x00\x00\x00\x00\x00\x00\xc3\xff\xc6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa3\xff\xa3\xff\x00\x00\x00\x00\xe0\xff\xe1\xff\x00\x00\xe2\xff\xde\xff\xe1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\xff\x00\x00\xce\xff\x00\x00\xd7\xff\x00\x00\xbe\xff\xdc\xff\x00\x00\x00\x00\xc7\xff\xc2\xff\x00\x00\xbd\xff\xbb\xff\xba\xff\x00\x00\x00\x00\xac\xff\xb5\xff\x00\x00\x00\x00\xa8\xff\x00\x00\xcb\xff\xca\xff\x00\x00\x00\x00\x9e\xff\x9c\xff\x9b\xff\x9a\xff\x00\x00\x00\x00\x00\x00\x90\xff\x97\xff\x96\xff\xa2\xff\xa0\xff\xa5\xff\xc9\xff\xad\xff\xae\xff\xaa\xff\xb7\xff\xb8\xff\xc1\xff\x00\x00\xc5\xff\x00\x00\xd3\xff\xdb\xff\x00\x00\x00\x00\x00\x00\xcf\xff\x00\x00\xcb\xff\x00\x00\x00\x00\xd9\xff\xdf\xff\xd5\xff\xd6\xff\xd2\xff\xd8\xff\x00\x00\xbc\xff\x00\x00\xcb\xff\x00\x00\xc0\xff\xdd\xff\xd1\xff\xa3\xff\xcb\xff\xda\xff\xd4\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x0d\x00\x01\x00\x0d\x00\x02\x00\x26\x00\x03\x00\x03\x00\x00\x00\x03\x00\x04\x00\x2b\x00\x2d\x00\x03\x00\x0d\x00\x0d\x00\x03\x00\x10\x00\x0c\x00\x10\x00\x10\x00\x02\x00\x15\x00\x06\x00\x17\x00\x00\x00\x10\x00\x1a\x00\x1b\x00\x10\x00\x01\x00\x01\x00\x2c\x00\x2b\x00\x2c\x00\x1b\x00\x1c\x00\x24\x00\x25\x00\x00\x00\x0a\x00\x28\x00\x0d\x00\x0d\x00\x01\x00\x0f\x00\x2d\x00\x11\x00\x12\x00\x13\x00\x14\x00\x2d\x00\x16\x00\x1c\x00\x18\x00\x19\x00\x0d\x00\x26\x00\x0f\x00\x1d\x00\x1e\x00\x1f\x00\x2d\x00\x21\x00\x22\x00\x01\x00\x1b\x00\x1c\x00\x2c\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2c\x00\x00\x00\x04\x00\x0d\x00\x1f\x00\x0f\x00\x21\x00\x11\x00\x12\x00\x13\x00\x14\x00\x0d\x00\x16\x00\x2c\x00\x18\x00\x19\x00\x01\x00\x04\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x21\x00\x22\x00\x04\x00\x0d\x00\x0e\x00\x0d\x00\x1c\x00\x1c\x00\x10\x00\x00\x00\x0c\x00\x2c\x00\x28\x00\x15\x00\x00\x00\x17\x00\x2b\x00\x00\x00\x1a\x00\x1b\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x24\x00\x25\x00\x00\x00\x06\x00\x28\x00\x2d\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x26\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x2d\x00\x13\x00\x05\x00\x15\x00\x20\x00\x2d\x00\x13\x00\x23\x00\x15\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x13\x00\x2b\x00\x15\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x08\x00\x03\x00\x04\x00\x11\x00\x12\x00\x13\x00\x14\x00\x05\x00\x0d\x00\x0e\x00\x0c\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\x04\x00\x2d\x00\x03\x00\x04\x00\x08\x00\x09\x00\x0a\x00\x08\x00\x09\x00\x0a\x00\x2b\x00\x11\x00\x12\x00\x13\x00\x14\x00\x2d\x00\x04\x00\x08\x00\x16\x00\x17\x00\x2c\x00\x16\x00\x17\x00\x03\x00\x04\x00\x0d\x00\x0e\x00\x0e\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x07\x00\x16\x00\x17\x00\x04\x00\x05\x00\x06\x00\x07\x00\x11\x00\x12\x00\x13\x00\x05\x00\x0c\x00\x11\x00\x12\x00\x13\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\x2d\x00\x2c\x00\x11\x00\x12\x00\x13\x00\x03\x00\x04\x00\x11\x00\x12\x00\x13\x00\x08\x00\x09\x00\x0a\x00\x12\x00\x13\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x2b\x00\x06\x00\x07\x00\x16\x00\x04\x00\x04\x00\x04\x00\x0c\x00\x06\x00\x07\x00\x2c\x00\x0a\x00\x0c\x00\x13\x00\x0c\x00\x04\x00\x04\x00\x06\x00\x07\x00\x07\x00\x03\x00\x04\x00\x22\x00\x0c\x00\x0c\x00\x08\x00\x09\x00\x0a\x00\x03\x00\x04\x00\x2c\x00\x03\x00\x04\x00\x08\x00\x09\x00\x0a\x00\x08\x00\x09\x00\x0a\x00\x03\x00\x04\x00\x1c\x00\x03\x00\x04\x00\x08\x00\x09\x00\x0a\x00\x08\x00\x04\x00\x0a\x00\x04\x00\x2c\x00\x04\x00\x2d\x00\x0a\x00\x0b\x00\x0a\x00\x0b\x00\x0a\x00\x0b\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\x2d\x00\x2c\x00\x2b\x00\x07\x00\x2b\x00\x0e\x00\x2a\x00\x2c\x00\x02\x00\x2b\x00\x2b\x00\x0e\x00\x27\x00\x0e\x00\x06\x00\x0e\x00\x09\x00\x26\x00\x2b\x00\x09\x00\x0b\x00\x02\x00\x1c\x00\x03\x00\x18\x00\x03\x00\x0f\x00\x03\x00\x03\x00\x18\x00\x04\x00\x03\x00\x0f\x00\x04\x00\x04\x00\x04\x00\x18\x00\x04\x00\x03\x00\x03\x00\x02\x00\xff\xff\x03\x00\x03\x00\x03\x00\x18\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"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x35\x00\x1d\x00\x35\x00\xa8\x00\x94\x00\x4b\x00\x4b\x00\x1a\x00\x96\x00\x97\x00\x36\x00\xff\xff\x4b\x00\x1e\x00\xa9\x00\x4b\x00\x1f\x00\x98\x00\x4c\x00\x78\x00\x9c\x00\x20\x00\x93\x00\x21\x00\x1a\x00\xb0\x00\x22\x00\x23\x00\xa6\x00\x40\x00\x57\x00\x37\x00\x36\x00\x37\x00\x25\x00\x26\x00\x24\x00\x25\x00\x1a\x00\x6f\x00\x1a\x00\x41\x00\x58\x00\x57\x00\x59\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\xff\xff\x65\x00\x1b\x00\x66\x00\x67\x00\x58\x00\x94\x00\x59\x00\x68\x00\x69\x00\x6a\x00\xff\xff\x6b\x00\x6c\x00\x57\x00\x9f\x00\x26\x00\x37\x00\x1a\x00\x42\x00\x43\x00\x36\x00\x37\x00\x37\x00\x1a\x00\x50\x00\x58\x00\x4f\x00\x59\x00\x50\x00\x61\x00\x62\x00\x63\x00\x64\x00\x53\x00\x65\x00\x37\x00\x66\x00\x67\x00\x1d\x00\x50\x00\x1a\x00\x68\x00\x69\x00\x6a\x00\x1a\x00\x6b\x00\x6c\x00\x54\x00\x51\x00\x52\x00\x1e\x00\x94\x00\x2d\x00\x1f\x00\x1a\x00\x55\x00\x37\x00\x1a\x00\x20\x00\x1a\x00\x21\x00\x36\x00\x1a\x00\x22\x00\x23\x00\x29\x00\x2a\x00\x28\x00\x26\x00\x9a\x00\x2a\x00\x28\x00\x26\x00\x24\x00\x25\x00\x1a\x00\x93\x00\x1a\x00\xff\xff\xb5\x00\x2a\x00\x28\x00\x26\x00\x91\x00\xba\x00\x2a\x00\x28\x00\x26\x00\x27\x00\x28\x00\x26\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x9e\x00\x28\x00\x26\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\xff\xff\x3d\x00\x8b\x00\x3e\x00\x7a\x00\xff\xff\x3d\x00\x7b\x00\x8e\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x43\x00\x3d\x00\x36\x00\x8b\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x43\x00\x50\x00\x8a\x00\x96\x00\x97\x00\x44\x00\x45\x00\x46\x00\x47\x00\x89\x00\x51\x00\x85\x00\x98\x00\x44\x00\x45\x00\x46\x00\x8c\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x43\x00\x2d\x00\x2e\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x2f\x00\x30\x00\x31\x00\x36\x00\x44\x00\x45\x00\x46\x00\xa4\x00\xff\xff\x50\x00\x85\x00\x32\x00\x33\x00\x37\x00\x32\x00\xa0\x00\x2d\x00\x2e\x00\x51\x00\xad\x00\x84\x00\x2f\x00\x30\x00\x31\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x43\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x43\x00\x82\x00\x32\x00\xb9\x00\x54\x00\x6f\x00\x70\x00\x6d\x00\x4a\x00\x45\x00\x46\x00\x83\x00\x5f\x00\x8d\x00\x45\x00\x46\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x43\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x43\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x43\x00\xff\xff\x37\x00\xa5\x00\x45\x00\x46\x00\x2d\x00\x2e\x00\xc2\x00\x45\x00\x46\x00\x2f\x00\x30\x00\x31\x00\x49\x00\x46\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x54\x00\x36\x00\x6c\x00\x6d\x00\x37\x00\x54\x00\x2e\x00\x54\x00\x5f\x00\x71\x00\x6d\x00\x37\x00\x5b\x00\x7b\x00\x48\x00\x5f\x00\x54\x00\x54\x00\xb6\x00\x6d\x00\x5e\x00\x2d\x00\x2e\x00\x78\x00\x5f\x00\x5f\x00\x2f\x00\x5c\x00\x31\x00\x2d\x00\x2e\x00\x37\x00\x2d\x00\x2e\x00\x2f\x00\x91\x00\x31\x00\x2f\x00\xc1\x00\x31\x00\x2d\x00\x2e\x00\x2d\x00\x2d\x00\x2e\x00\x2f\x00\xc5\x00\x31\x00\x5d\x00\x2e\x00\x31\x00\x2e\x00\x37\x00\x2e\x00\xff\xff\x59\x00\x5a\x00\x59\x00\x7c\x00\x59\x00\xa9\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x8f\x00\x7d\x00\xb4\x00\xb3\x00\xaa\x00\xbb\x00\x73\x00\xb3\x00\xff\xff\x37\x00\x36\x00\xb0\x00\x36\x00\xa4\x00\x43\x00\x37\x00\xa3\x00\x36\x00\x36\x00\xa2\x00\x9e\x00\x9d\x00\x93\x00\xc0\x00\xbf\x00\x94\x00\x36\x00\xc5\x00\xbe\x00\xc1\x00\x2d\x00\x99\x00\x2b\x00\x98\x00\x4d\x00\x87\x00\x86\x00\x75\x00\x80\x00\x7f\x00\xc3\x00\x7e\x00\x76\x00\x73\x00\x74\x00\xb1\x00\xae\x00\xac\x00\xab\x00\x00\x00\xbc\x00\xb8\x00\xb7\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (24, 111) [ + (24 , happyReduce_24), + (25 , happyReduce_25), + (26 , happyReduce_26), + (27 , happyReduce_27), + (28 , happyReduce_28), + (29 , happyReduce_29), + (30 , happyReduce_30), + (31 , happyReduce_31), + (32 , happyReduce_32), + (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) + ] + +happy_n_terms = 46 :: Prelude.Int +happy_n_nonterms = 29 :: Prelude.Int + +happyReduce_24 = happySpecReduce_1 0# happyReduction_24 +happyReduction_24 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TC happy_var_1)) -> + happyIn27 + ((read happy_var_1) :: Char + )} + +happyReduce_25 = happySpecReduce_1 1# happyReduction_25 +happyReduction_25 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> + happyIn28 + ((read happy_var_1) :: Double + )} + +happyReduce_26 = happySpecReduce_1 2# happyReduction_26 +happyReduction_26 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> + happyIn29 + ((read happy_var_1) :: Integer + )} + +happyReduce_27 = happySpecReduce_1 3# happyReduction_27 +happyReduction_27 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> + happyIn30 + (happy_var_1 + )} + +happyReduce_28 = happySpecReduce_1 4# happyReduction_28 +happyReduction_28 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn31 + (BNFC.Abs.Identifier (mkPosToken happy_var_1) + )} + +happyReduce_29 = happySpecReduce_1 5# happyReduction_29 +happyReduction_29 happy_x_1 + = case happyOut33 happy_x_1 of { (HappyWrap33 happy_var_1) -> + happyIn32 + (BNFC.Abs.Grammar happy_var_1 + )} + +happyReduce_30 = happySpecReduce_0 6# happyReduction_30 +happyReduction_30 = happyIn33 + ([] + ) + +happyReduce_31 = happySpecReduce_1 6# happyReduction_31 +happyReduction_31 happy_x_1 + = case happyOut34 happy_x_1 of { (HappyWrap34 happy_var_1) -> + happyIn33 + ((:[]) happy_var_1 + )} + +happyReduce_32 = happySpecReduce_3 6# happyReduction_32 +happyReduction_32 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut34 happy_x_1 of { (HappyWrap34 happy_var_1) -> + case happyOut33 happy_x_3 of { (HappyWrap33 happy_var_3) -> + happyIn33 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_33 = happySpecReduce_2 6# happyReduction_33 +happyReduction_33 happy_x_2 + happy_x_1 + = case happyOut33 happy_x_2 of { (HappyWrap33 happy_var_2) -> + happyIn33 + (happy_var_2 + )} + +happyReduce_34 = happyReduce 5# 7# happyReduction_34 +happyReduction_34 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut39 happy_x_1 of { (HappyWrap39 happy_var_1) -> + case happyOut37 happy_x_3 of { (HappyWrap37 happy_var_3) -> + case happyOut36 happy_x_5 of { (HappyWrap36 happy_var_5) -> + happyIn34 + (BNFC.Abs.Rule happy_var_1 happy_var_3 happy_var_5 + ) `HappyStk` happyRest}}} + +happyReduce_35 = happySpecReduce_2 7# happyReduction_35 +happyReduction_35 happy_x_2 + happy_x_1 + = case happyOut30 happy_x_2 of { (HappyWrap30 happy_var_2) -> + happyIn34 + (BNFC.Abs.Comment happy_var_2 + )} + +happyReduce_36 = happySpecReduce_3 7# happyReduction_36 +happyReduction_36 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_2 of { (HappyWrap30 happy_var_2) -> + case happyOut30 happy_x_3 of { (HappyWrap30 happy_var_3) -> + happyIn34 + (BNFC.Abs.Comments happy_var_2 happy_var_3 + )}} + +happyReduce_37 = happyReduce 6# 7# happyReduction_37 +happyReduction_37 (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 happyOut39 happy_x_2 of { (HappyWrap39 happy_var_2) -> + case happyOut37 happy_x_4 of { (HappyWrap37 happy_var_4) -> + case happyOut36 happy_x_6 of { (HappyWrap36 happy_var_6) -> + happyIn34 + (BNFC.Abs.Internal happy_var_2 happy_var_4 happy_var_6 + ) `HappyStk` happyRest}}} + +happyReduce_38 = happySpecReduce_3 7# happyReduction_38 +happyReduction_38 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut31 happy_x_2 of { (HappyWrap31 happy_var_2) -> + case happyOut52 happy_x_3 of { (HappyWrap52 happy_var_3) -> + happyIn34 + (BNFC.Abs.Token happy_var_2 happy_var_3 + )}} + +happyReduce_39 = happyReduce 4# 7# happyReduction_39 +happyReduction_39 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut31 happy_x_3 of { (HappyWrap31 happy_var_3) -> + case happyOut52 happy_x_4 of { (HappyWrap52 happy_var_4) -> + happyIn34 + (BNFC.Abs.PosToken happy_var_3 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_40 = happySpecReduce_2 7# happyReduction_40 +happyReduction_40 happy_x_2 + happy_x_1 + = case happyOut38 happy_x_2 of { (HappyWrap38 happy_var_2) -> + happyIn34 + (BNFC.Abs.Entryp happy_var_2 + )} + +happyReduce_41 = happyReduce 4# 7# happyReduction_41 +happyReduction_41 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut51 happy_x_2 of { (HappyWrap51 happy_var_2) -> + case happyOut37 happy_x_3 of { (HappyWrap37 happy_var_3) -> + case happyOut30 happy_x_4 of { (HappyWrap30 happy_var_4) -> + happyIn34 + (BNFC.Abs.Separator happy_var_2 happy_var_3 happy_var_4 + ) `HappyStk` happyRest}}} + +happyReduce_42 = happyReduce 4# 7# happyReduction_42 +happyReduction_42 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut51 happy_x_2 of { (HappyWrap51 happy_var_2) -> + case happyOut37 happy_x_3 of { (HappyWrap37 happy_var_3) -> + case happyOut30 happy_x_4 of { (HappyWrap30 happy_var_4) -> + happyIn34 + (BNFC.Abs.Terminator happy_var_2 happy_var_3 happy_var_4 + ) `HappyStk` happyRest}}} + +happyReduce_43 = happyReduce 6# 7# happyReduction_43 +happyReduction_43 (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 happyOut37 happy_x_2 of { (HappyWrap37 happy_var_2) -> + case happyOut30 happy_x_3 of { (HappyWrap30 happy_var_3) -> + case happyOut30 happy_x_4 of { (HappyWrap30 happy_var_4) -> + case happyOut42 happy_x_5 of { (HappyWrap42 happy_var_5) -> + case happyOut51 happy_x_6 of { (HappyWrap51 happy_var_6) -> + happyIn34 + (BNFC.Abs.Delimiters happy_var_2 happy_var_3 happy_var_4 happy_var_5 happy_var_6 + ) `HappyStk` happyRest}}}}} + +happyReduce_44 = happySpecReduce_3 7# happyReduction_44 +happyReduction_44 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut31 happy_x_2 of { (HappyWrap31 happy_var_2) -> + case happyOut29 happy_x_3 of { (HappyWrap29 happy_var_3) -> + happyIn34 + (BNFC.Abs.Coercions happy_var_2 happy_var_3 + )}} + +happyReduce_45 = happyReduce 4# 7# happyReduction_45 +happyReduction_45 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut31 happy_x_2 of { (HappyWrap31 happy_var_2) -> + case happyOut50 happy_x_4 of { (HappyWrap50 happy_var_4) -> + happyIn34 + (BNFC.Abs.Rules happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_46 = happyReduce 5# 7# happyReduction_46 +happyReduction_46 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut31 happy_x_2 of { (HappyWrap31 happy_var_2) -> + case happyOut41 happy_x_3 of { (HappyWrap41 happy_var_3) -> + case happyOut44 happy_x_5 of { (HappyWrap44 happy_var_5) -> + happyIn34 + (BNFC.Abs.Function happy_var_2 happy_var_3 happy_var_5 + ) `HappyStk` happyRest}}} + +happyReduce_47 = happySpecReduce_2 7# happyReduction_47 +happyReduction_47 happy_x_2 + happy_x_1 + = case happyOut43 happy_x_2 of { (HappyWrap43 happy_var_2) -> + happyIn34 + (BNFC.Abs.Layout happy_var_2 + )} + +happyReduce_48 = happySpecReduce_3 7# happyReduction_48 +happyReduction_48 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut43 happy_x_3 of { (HappyWrap43 happy_var_3) -> + happyIn34 + (BNFC.Abs.LayoutStop happy_var_3 + )} + +happyReduce_49 = happySpecReduce_2 7# happyReduction_49 +happyReduction_49 happy_x_2 + happy_x_1 + = happyIn34 + (BNFC.Abs.LayoutTop + ) + +happyReduce_50 = happySpecReduce_1 8# happyReduction_50 +happyReduction_50 happy_x_1 + = case happyOut30 happy_x_1 of { (HappyWrap30 happy_var_1) -> + happyIn35 + (BNFC.Abs.Terminal happy_var_1 + )} + +happyReduce_51 = happySpecReduce_1 8# happyReduction_51 +happyReduction_51 happy_x_1 + = case happyOut37 happy_x_1 of { (HappyWrap37 happy_var_1) -> + happyIn35 + (BNFC.Abs.NTerminal happy_var_1 + )} + +happyReduce_52 = happySpecReduce_0 9# happyReduction_52 +happyReduction_52 = happyIn36 + ([] + ) + +happyReduce_53 = happySpecReduce_2 9# happyReduction_53 +happyReduction_53 happy_x_2 + happy_x_1 + = case happyOut35 happy_x_1 of { (HappyWrap35 happy_var_1) -> + case happyOut36 happy_x_2 of { (HappyWrap36 happy_var_2) -> + happyIn36 + ((:) happy_var_1 happy_var_2 + )}} + +happyReduce_54 = happySpecReduce_3 10# happyReduction_54 +happyReduction_54 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut37 happy_x_2 of { (HappyWrap37 happy_var_2) -> + happyIn37 + (BNFC.Abs.ListCat happy_var_2 + )} + +happyReduce_55 = happySpecReduce_1 10# happyReduction_55 +happyReduction_55 happy_x_1 + = case happyOut31 happy_x_1 of { (HappyWrap31 happy_var_1) -> + happyIn37 + (BNFC.Abs.IdCat happy_var_1 + )} + +happyReduce_56 = happySpecReduce_0 11# happyReduction_56 +happyReduction_56 = happyIn38 + ([] + ) + +happyReduce_57 = happySpecReduce_1 11# happyReduction_57 +happyReduction_57 happy_x_1 + = case happyOut37 happy_x_1 of { (HappyWrap37 happy_var_1) -> + happyIn38 + ((:[]) happy_var_1 + )} + +happyReduce_58 = happySpecReduce_3 11# happyReduction_58 +happyReduction_58 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut37 happy_x_1 of { (HappyWrap37 happy_var_1) -> + case happyOut38 happy_x_3 of { (HappyWrap38 happy_var_3) -> + happyIn38 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_59 = happySpecReduce_1 12# happyReduction_59 +happyReduction_59 happy_x_1 + = case happyOut31 happy_x_1 of { (HappyWrap31 happy_var_1) -> + happyIn39 + (BNFC.Abs.Id happy_var_1 + )} + +happyReduce_60 = happySpecReduce_1 12# happyReduction_60 +happyReduction_60 happy_x_1 + = happyIn39 + (BNFC.Abs.Wild + ) + +happyReduce_61 = happySpecReduce_2 12# happyReduction_61 +happyReduction_61 happy_x_2 + happy_x_1 + = happyIn39 + (BNFC.Abs.ListE + ) + +happyReduce_62 = happySpecReduce_3 12# happyReduction_62 +happyReduction_62 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn39 + (BNFC.Abs.ListCons + ) + +happyReduce_63 = happyReduce 5# 12# 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) + = happyIn39 + (BNFC.Abs.ListOne + ) `HappyStk` happyRest + +happyReduce_64 = happySpecReduce_1 13# happyReduction_64 +happyReduction_64 happy_x_1 + = case happyOut31 happy_x_1 of { (HappyWrap31 happy_var_1) -> + happyIn40 + (BNFC.Abs.Arg happy_var_1 + )} + +happyReduce_65 = happySpecReduce_0 14# happyReduction_65 +happyReduction_65 = happyIn41 + ([] + ) + +happyReduce_66 = happySpecReduce_2 14# happyReduction_66 +happyReduction_66 happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { (HappyWrap40 happy_var_1) -> + case happyOut41 happy_x_2 of { (HappyWrap41 happy_var_2) -> + happyIn41 + ((:) happy_var_1 happy_var_2 + )}} + +happyReduce_67 = happySpecReduce_0 15# happyReduction_67 +happyReduction_67 = happyIn42 + (BNFC.Abs.SepNone + ) + +happyReduce_68 = happySpecReduce_2 15# happyReduction_68 +happyReduction_68 happy_x_2 + happy_x_1 + = case happyOut30 happy_x_2 of { (HappyWrap30 happy_var_2) -> + happyIn42 + (BNFC.Abs.SepTerm happy_var_2 + )} + +happyReduce_69 = happySpecReduce_2 15# happyReduction_69 +happyReduction_69 happy_x_2 + happy_x_1 + = case happyOut30 happy_x_2 of { (HappyWrap30 happy_var_2) -> + happyIn42 + (BNFC.Abs.SepSepar happy_var_2 + )} + +happyReduce_70 = happySpecReduce_1 16# happyReduction_70 +happyReduction_70 happy_x_1 + = case happyOut30 happy_x_1 of { (HappyWrap30 happy_var_1) -> + happyIn43 + ((:[]) happy_var_1 + )} + +happyReduce_71 = happySpecReduce_3 16# happyReduction_71 +happyReduction_71 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { (HappyWrap30 happy_var_1) -> + case happyOut43 happy_x_3 of { (HappyWrap43 happy_var_3) -> + happyIn43 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_72 = happySpecReduce_3 17# happyReduction_72 +happyReduction_72 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut45 happy_x_1 of { (HappyWrap45 happy_var_1) -> + case happyOut44 happy_x_3 of { (HappyWrap44 happy_var_3) -> + happyIn44 + (BNFC.Abs.Cons happy_var_1 happy_var_3 + )}} + +happyReduce_73 = happySpecReduce_1 17# happyReduction_73 +happyReduction_73 happy_x_1 + = case happyOut45 happy_x_1 of { (HappyWrap45 happy_var_1) -> + happyIn44 + (happy_var_1 + )} + +happyReduce_74 = happySpecReduce_2 18# happyReduction_74 +happyReduction_74 happy_x_2 + happy_x_1 + = case happyOut31 happy_x_1 of { (HappyWrap31 happy_var_1) -> + case happyOut48 happy_x_2 of { (HappyWrap48 happy_var_2) -> + happyIn45 + (BNFC.Abs.App happy_var_1 happy_var_2 + )}} + +happyReduce_75 = happySpecReduce_1 18# happyReduction_75 +happyReduction_75 happy_x_1 + = case happyOut46 happy_x_1 of { (HappyWrap46 happy_var_1) -> + happyIn45 + (happy_var_1 + )} + +happyReduce_76 = happySpecReduce_1 19# happyReduction_76 +happyReduction_76 happy_x_1 + = case happyOut31 happy_x_1 of { (HappyWrap31 happy_var_1) -> + happyIn46 + (BNFC.Abs.Var happy_var_1 + )} + +happyReduce_77 = happySpecReduce_1 19# happyReduction_77 +happyReduction_77 happy_x_1 + = case happyOut29 happy_x_1 of { (HappyWrap29 happy_var_1) -> + happyIn46 + (BNFC.Abs.LitInt happy_var_1 + )} + +happyReduce_78 = happySpecReduce_1 19# happyReduction_78 +happyReduction_78 happy_x_1 + = case happyOut27 happy_x_1 of { (HappyWrap27 happy_var_1) -> + happyIn46 + (BNFC.Abs.LitChar happy_var_1 + )} + +happyReduce_79 = happySpecReduce_1 19# happyReduction_79 +happyReduction_79 happy_x_1 + = case happyOut30 happy_x_1 of { (HappyWrap30 happy_var_1) -> + happyIn46 + (BNFC.Abs.LitString happy_var_1 + )} + +happyReduce_80 = happySpecReduce_1 19# happyReduction_80 +happyReduction_80 happy_x_1 + = case happyOut28 happy_x_1 of { (HappyWrap28 happy_var_1) -> + happyIn46 + (BNFC.Abs.LitDouble happy_var_1 + )} + +happyReduce_81 = happySpecReduce_3 19# happyReduction_81 +happyReduction_81 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut47 happy_x_2 of { (HappyWrap47 happy_var_2) -> + happyIn46 + (BNFC.Abs.List happy_var_2 + )} + +happyReduce_82 = happySpecReduce_3 19# happyReduction_82 +happyReduction_82 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut44 happy_x_2 of { (HappyWrap44 happy_var_2) -> + happyIn46 + (happy_var_2 + )} + +happyReduce_83 = happySpecReduce_0 20# happyReduction_83 +happyReduction_83 = happyIn47 + ([] + ) + +happyReduce_84 = happySpecReduce_1 20# happyReduction_84 +happyReduction_84 happy_x_1 + = case happyOut44 happy_x_1 of { (HappyWrap44 happy_var_1) -> + happyIn47 + ((:[]) happy_var_1 + )} + +happyReduce_85 = happySpecReduce_3 20# happyReduction_85 +happyReduction_85 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut44 happy_x_1 of { (HappyWrap44 happy_var_1) -> + case happyOut47 happy_x_3 of { (HappyWrap47 happy_var_3) -> + happyIn47 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_86 = happySpecReduce_1 21# happyReduction_86 +happyReduction_86 happy_x_1 + = case happyOut46 happy_x_1 of { (HappyWrap46 happy_var_1) -> + happyIn48 + ((:[]) happy_var_1 + )} + +happyReduce_87 = happySpecReduce_2 21# happyReduction_87 +happyReduction_87 happy_x_2 + happy_x_1 + = case happyOut46 happy_x_1 of { (HappyWrap46 happy_var_1) -> + case happyOut48 happy_x_2 of { (HappyWrap48 happy_var_2) -> + happyIn48 + ((:) happy_var_1 happy_var_2 + )}} + +happyReduce_88 = happySpecReduce_1 22# happyReduction_88 +happyReduction_88 happy_x_1 + = case happyOut36 happy_x_1 of { (HappyWrap36 happy_var_1) -> + happyIn49 + (BNFC.Abs.RHS happy_var_1 + )} + +happyReduce_89 = happySpecReduce_1 23# happyReduction_89 +happyReduction_89 happy_x_1 + = case happyOut49 happy_x_1 of { (HappyWrap49 happy_var_1) -> + happyIn50 + ((:[]) happy_var_1 + )} + +happyReduce_90 = happySpecReduce_3 23# happyReduction_90 +happyReduction_90 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut49 happy_x_1 of { (HappyWrap49 happy_var_1) -> + case happyOut50 happy_x_3 of { (HappyWrap50 happy_var_3) -> + happyIn50 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_91 = happySpecReduce_1 24# happyReduction_91 +happyReduction_91 happy_x_1 + = happyIn51 + (BNFC.Abs.MNonempty + ) + +happyReduce_92 = happySpecReduce_0 24# happyReduction_92 +happyReduction_92 = happyIn51 + (BNFC.Abs.MEmpty + ) + +happyReduce_93 = happySpecReduce_3 25# happyReduction_93 +happyReduction_93 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut52 happy_x_1 of { (HappyWrap52 happy_var_1) -> + case happyOut53 happy_x_3 of { (HappyWrap53 happy_var_3) -> + happyIn52 + (BNFC.Abs.RAlt happy_var_1 happy_var_3 + )}} + +happyReduce_94 = happySpecReduce_1 25# happyReduction_94 +happyReduction_94 happy_x_1 + = case happyOut53 happy_x_1 of { (HappyWrap53 happy_var_1) -> + happyIn52 + (happy_var_1 + )} + +happyReduce_95 = happySpecReduce_3 26# happyReduction_95 +happyReduction_95 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut53 happy_x_1 of { (HappyWrap53 happy_var_1) -> + case happyOut54 happy_x_3 of { (HappyWrap54 happy_var_3) -> + happyIn53 + (BNFC.Abs.RMinus happy_var_1 happy_var_3 + )}} + +happyReduce_96 = happySpecReduce_1 26# happyReduction_96 +happyReduction_96 happy_x_1 + = case happyOut54 happy_x_1 of { (HappyWrap54 happy_var_1) -> + happyIn53 + (happy_var_1 + )} + +happyReduce_97 = happySpecReduce_2 27# happyReduction_97 +happyReduction_97 happy_x_2 + happy_x_1 + = case happyOut54 happy_x_1 of { (HappyWrap54 happy_var_1) -> + case happyOut55 happy_x_2 of { (HappyWrap55 happy_var_2) -> + happyIn54 + (BNFC.Abs.RSeq happy_var_1 happy_var_2 + )}} + +happyReduce_98 = happySpecReduce_1 27# happyReduction_98 +happyReduction_98 happy_x_1 + = case happyOut55 happy_x_1 of { (HappyWrap55 happy_var_1) -> + happyIn54 + (happy_var_1 + )} + +happyReduce_99 = happySpecReduce_2 28# happyReduction_99 +happyReduction_99 happy_x_2 + happy_x_1 + = case happyOut55 happy_x_1 of { (HappyWrap55 happy_var_1) -> + happyIn55 + (BNFC.Abs.RStar happy_var_1 + )} + +happyReduce_100 = happySpecReduce_2 28# happyReduction_100 +happyReduction_100 happy_x_2 + happy_x_1 + = case happyOut55 happy_x_1 of { (HappyWrap55 happy_var_1) -> + happyIn55 + (BNFC.Abs.RPlus happy_var_1 + )} + +happyReduce_101 = happySpecReduce_2 28# happyReduction_101 +happyReduction_101 happy_x_2 + happy_x_1 + = case happyOut55 happy_x_1 of { (HappyWrap55 happy_var_1) -> + happyIn55 + (BNFC.Abs.ROpt happy_var_1 + )} + +happyReduce_102 = happySpecReduce_1 28# happyReduction_102 +happyReduction_102 happy_x_1 + = happyIn55 + (BNFC.Abs.REps + ) + +happyReduce_103 = happySpecReduce_1 28# happyReduction_103 +happyReduction_103 happy_x_1 + = case happyOut27 happy_x_1 of { (HappyWrap27 happy_var_1) -> + happyIn55 + (BNFC.Abs.RChar happy_var_1 + )} + +happyReduce_104 = happySpecReduce_3 28# happyReduction_104 +happyReduction_104 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_2 of { (HappyWrap30 happy_var_2) -> + happyIn55 + (BNFC.Abs.RAlts happy_var_2 + )} + +happyReduce_105 = happySpecReduce_3 28# happyReduction_105 +happyReduction_105 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_2 of { (HappyWrap30 happy_var_2) -> + happyIn55 + (BNFC.Abs.RSeqs happy_var_2 + )} + +happyReduce_106 = happySpecReduce_1 28# happyReduction_106 +happyReduction_106 happy_x_1 + = happyIn55 + (BNFC.Abs.RDigit + ) + +happyReduce_107 = happySpecReduce_1 28# happyReduction_107 +happyReduction_107 happy_x_1 + = happyIn55 + (BNFC.Abs.RLetter + ) + +happyReduce_108 = happySpecReduce_1 28# happyReduction_108 +happyReduction_108 happy_x_1 + = happyIn55 + (BNFC.Abs.RUpper + ) + +happyReduce_109 = happySpecReduce_1 28# happyReduction_109 +happyReduction_109 happy_x_1 + = happyIn55 + (BNFC.Abs.RLower + ) + +happyReduce_110 = happySpecReduce_1 28# happyReduction_110 +happyReduction_110 happy_x_1 + = happyIn55 + (BNFC.Abs.RAny + ) + +happyReduce_111 = happySpecReduce_3 28# happyReduction_111 +happyReduction_111 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut52 happy_x_2 of { (HappyWrap52 happy_var_2) -> + happyIn55 + (happy_var_2 + )} + +happyNewToken action sts stk [] = + happyDoAction 45# 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 _ (TC happy_dollar_dollar) -> cont 40#; + PT _ (TD happy_dollar_dollar) -> cont 41#; + PT _ (TI happy_dollar_dollar) -> cont 42#; + PT _ (TL happy_dollar_dollar) -> cont 43#; + PT _ (T_Identifier _) -> cont 44#; + _ -> happyError' ((tk:tks), []) + } + +happyError_ explist 45# tk tks = happyError' (tks, explist) +happyError_ explist _ tk tks = happyError' ((tk:tks), explist) + +happyThen :: () => Err a -> (a -> Err b) -> Err b +happyThen = ((>>=)) +happyReturn :: () => a -> Err a +happyReturn = (return) +happyThen1 m k tks = ((>>=)) m (\a -> k a tks) +happyReturn1 :: () => a -> b -> Err a +happyReturn1 = \a tks -> (return) a +happyError' :: () => ([(Token)], [Prelude.String]) -> Err a +happyError' = (\(tokens, _) -> happyError tokens) +pGrammar tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (let {(HappyWrap32 x') = happyOut32 x} in x')) + +pListDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (let {(HappyWrap33 x') = happyOut33 x} in x')) + +pDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (let {(HappyWrap34 x') = happyOut34 x} in x')) + +pItem tks = happySomeParser where + happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (let {(HappyWrap35 x') = happyOut35 x} in x')) + +pListItem tks = happySomeParser where + happySomeParser = happyThen (happyParse 4# tks) (\x -> happyReturn (let {(HappyWrap36 x') = happyOut36 x} in x')) + +pCat tks = happySomeParser where + happySomeParser = happyThen (happyParse 5# tks) (\x -> happyReturn (let {(HappyWrap37 x') = happyOut37 x} in x')) + +pListCat tks = happySomeParser where + happySomeParser = happyThen (happyParse 6# tks) (\x -> happyReturn (let {(HappyWrap38 x') = happyOut38 x} in x')) + +pLabel tks = happySomeParser where + happySomeParser = happyThen (happyParse 7# tks) (\x -> happyReturn (let {(HappyWrap39 x') = happyOut39 x} in x')) + +pArg tks = happySomeParser where + happySomeParser = happyThen (happyParse 8# tks) (\x -> happyReturn (let {(HappyWrap40 x') = happyOut40 x} in x')) + +pListArg tks = happySomeParser where + happySomeParser = happyThen (happyParse 9# tks) (\x -> happyReturn (let {(HappyWrap41 x') = happyOut41 x} in x')) + +pSeparation tks = happySomeParser where + happySomeParser = happyThen (happyParse 10# tks) (\x -> happyReturn (let {(HappyWrap42 x') = happyOut42 x} in x')) + +pListString tks = happySomeParser where + happySomeParser = happyThen (happyParse 11# tks) (\x -> happyReturn (let {(HappyWrap43 x') = happyOut43 x} in x')) + +pExp tks = happySomeParser where + happySomeParser = happyThen (happyParse 12# tks) (\x -> happyReturn (let {(HappyWrap44 x') = happyOut44 x} in x')) + +pExp1 tks = happySomeParser where + happySomeParser = happyThen (happyParse 13# tks) (\x -> happyReturn (let {(HappyWrap45 x') = happyOut45 x} in x')) + +pExp2 tks = happySomeParser where + happySomeParser = happyThen (happyParse 14# tks) (\x -> happyReturn (let {(HappyWrap46 x') = happyOut46 x} in x')) + +pListExp tks = happySomeParser where + happySomeParser = happyThen (happyParse 15# tks) (\x -> happyReturn (let {(HappyWrap47 x') = happyOut47 x} in x')) + +pListExp2 tks = happySomeParser where + happySomeParser = happyThen (happyParse 16# tks) (\x -> happyReturn (let {(HappyWrap48 x') = happyOut48 x} in x')) + +pRHS tks = happySomeParser where + happySomeParser = happyThen (happyParse 17# tks) (\x -> happyReturn (let {(HappyWrap49 x') = happyOut49 x} in x')) + +pListRHS tks = happySomeParser where + happySomeParser = happyThen (happyParse 18# tks) (\x -> happyReturn (let {(HappyWrap50 x') = happyOut50 x} in x')) + +pMinimumSize tks = happySomeParser where + happySomeParser = happyThen (happyParse 19# tks) (\x -> happyReturn (let {(HappyWrap51 x') = happyOut51 x} in x')) + +pReg tks = happySomeParser where + happySomeParser = happyThen (happyParse 20# tks) (\x -> happyReturn (let {(HappyWrap52 x') = happyOut52 x} in x')) + +pReg1 tks = happySomeParser where + happySomeParser = happyThen (happyParse 21# tks) (\x -> happyReturn (let {(HappyWrap53 x') = happyOut53 x} in x')) + +pReg2 tks = happySomeParser where + happySomeParser = happyThen (happyParse 22# tks) (\x -> happyReturn (let {(HappyWrap54 x') = happyOut54 x} in x')) + +pReg3 tks = happySomeParser where + happySomeParser = happyThen (happyParse 23# tks) (\x -> happyReturn (let {(HappyWrap55 x') = happyOut55 x} in x')) + +happySeq = happyDontSeq + + +type Err = Either String + +happyError :: [Token] -> Err a +happyError ts = Left $ + "syntax error at " ++ tokenPos ts ++ + case ts of + [] -> [] + [Err _] -> " due to lexer error" + t:_ -> " before `" ++ (prToken t) ++ "'" + +myLexer :: String -> [Token] +myLexer = tokens +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- $Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp $ + + + + + + + + + + + + + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Prelude.Bool) +#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Prelude.Bool) +#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Prelude.Bool) +#else +#define LT(n,m) (n Happy_GHC_Exts.<# m) +#define GTE(n,m) (n Happy_GHC_Exts.>=# m) +#define EQ(n,m) (n Happy_GHC_Exts.==# m) +#endif + + + + + + + + + + + + + + + + + + + +data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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 ERROR_TOK, 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 (happyExpListPerState ((Happy_GHC_Exts.I# (st)) :: Prelude.Int)) i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} + (happyReduceArr Happy_Data_Array.! rule) i tk st + where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) + n -> {- nothing -} + happyShift new_state i tk st + where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) + where off = happyAdjustOffset (indexShortOffAddr happyActOffsets st) + off_i = (off Happy_GHC_Exts.+# i) + check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) + then EQ(indexShortOffAddr happyCheck off_i, i) + else Prelude.False + action + | check = indexShortOffAddr happyTable off_i + | Prelude.otherwise = indexShortOffAddr happyDefActions st + + + + +indexShortOffAddr (HappyA# arr) off = + Happy_GHC_Exts.narrow16Int# i + where + i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) + high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) + low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) + off' = off Happy_GHC_Exts.*# 2# + + + + +{-# INLINE happyLt #-} +happyLt x y = LT(x,y) + + +readArrayBit arr bit = + Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `Prelude.mod` 16) + where unbox_int (Happy_GHC_Exts.I# x) = x + + + + + + +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + + + + + + + + + + + + + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk in + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk + + off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1) + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + + in + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st) + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (ERROR_TOK is the error token) + +-- parse error if we are in recovery and we fail again +happyFail explist 0# tk old_st _ stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "failing" $ + happyError_ explist i tk + +{- We don't need state discarding for our restricted implementation of + "error". In fact, it can cause some bogus parses, so I've disabled it + for now --SDM + +-- discard a state +happyFail ERROR_TOK tk old_st CONS(HAPPYSTATE(action),sts) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + DO_ACTION(action,ERROR_TOK,tk,sts,(saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail explist 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 = Prelude.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 `Prelude.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/src/BNFC/Par.y b/src/BNFC/Par.y --- a/src/BNFC/Par.y +++ b/src/BNFC/Par.y @@ -1,6 +1,8 @@ -- This Happy file was machine-generated by the BNF converter { {-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +{-# LANGUAGE PatternSynonyms #-} + module BNFC.Par ( happyError , myLexer @@ -29,8 +31,12 @@ , pReg2 , pReg3 ) where + +import Prelude + import qualified BNFC.Abs import BNFC.Lex + } %name pGrammar Grammar @@ -58,120 +64,125 @@ %name pReg2 Reg2 %name pReg3 Reg3 -- no lexer declaration -%monad { Either String } { (>>=) } { return } +%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) } - '{' { PT _ (TS _ 37) } - '|' { PT _ (TS _ 38) } - '}' { PT _ (TS _ 39) } - L_charac { PT _ (TC $$) } - L_doubl { PT _ (TD $$) } - L_integ { PT _ (TI $$) } - L_quoted { PT _ (TL $$) } - L_Identifier { PT _ (T_Identifier _) } + '(' { 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) } + '{' { PT _ (TS _ 37) } + '|' { PT _ (TS _ 38) } + '}' { PT _ (TS _ 39) } + L_charac { PT _ (TC $$) } + L_doubl { PT _ (TD $$) } + L_integ { PT _ (TI $$) } + L_quoted { PT _ (TL $$) } + L_Identifier { PT _ (T_Identifier _) } %% Char :: { Char } -Char : L_charac { (read ($1)) :: Char } +Char : L_charac { (read $1) :: Char } Double :: { Double } -Double : L_doubl { (read ($1)) :: Double } +Double : L_doubl { (read $1) :: Double } Integer :: { Integer } -Integer : L_integ { (read ($1)) :: Integer } +Integer : L_integ { (read $1) :: Integer } String :: { String } String : L_quoted { $1 } -Identifier :: { BNFC.Abs.Identifier} +Identifier :: { BNFC.Abs.Identifier } Identifier : L_Identifier { BNFC.Abs.Identifier (mkPosToken $1) } Grammar :: { BNFC.Abs.Grammar } Grammar : ListDef { BNFC.Abs.Grammar $1 } ListDef :: { [BNFC.Abs.Def] } -ListDef : {- empty -} { [] } - | Def { (:[]) $1 } - | Def ';' ListDef { (:) $1 $3 } - | ';' ListDef { $2 } +ListDef + : {- empty -} { [] } + | Def { (:[]) $1 } + | Def ';' ListDef { (:) $1 $3 } + | ';' ListDef { $2 } Def :: { BNFC.Abs.Def } -Def : Label '.' Cat '::=' ListItem { BNFC.Abs.Rule $1 $3 $5 } - | 'comment' String { BNFC.Abs.Comment $2 } - | 'comment' String String { BNFC.Abs.Comments $2 $3 } - | 'internal' Label '.' Cat '::=' ListItem { BNFC.Abs.Internal $2 $4 $6 } - | 'token' Identifier Reg { BNFC.Abs.Token $2 $3 } - | 'position' 'token' Identifier Reg { BNFC.Abs.PosToken $3 $4 } - | 'entrypoints' ListCat { BNFC.Abs.Entryp $2 } - | 'separator' MinimumSize Cat String { BNFC.Abs.Separator $2 $3 $4 } - | 'terminator' MinimumSize Cat String { BNFC.Abs.Terminator $2 $3 $4 } - | 'delimiters' Cat String String Separation MinimumSize { BNFC.Abs.Delimiters $2 $3 $4 $5 $6 } - | 'coercions' Identifier Integer { BNFC.Abs.Coercions $2 $3 } - | 'rules' Identifier '::=' ListRHS { BNFC.Abs.Rules $2 $4 } - | 'define' Identifier ListArg '=' Exp { BNFC.Abs.Function $2 $3 $5 } - | 'layout' ListString { BNFC.Abs.Layout $2 } - | 'layout' 'stop' ListString { BNFC.Abs.LayoutStop $3 } - | 'layout' 'toplevel' { BNFC.Abs.LayoutTop } +Def + : Label '.' Cat '::=' ListItem { BNFC.Abs.Rule $1 $3 $5 } + | 'comment' String { BNFC.Abs.Comment $2 } + | 'comment' String String { BNFC.Abs.Comments $2 $3 } + | 'internal' Label '.' Cat '::=' ListItem { BNFC.Abs.Internal $2 $4 $6 } + | 'token' Identifier Reg { BNFC.Abs.Token $2 $3 } + | 'position' 'token' Identifier Reg { BNFC.Abs.PosToken $3 $4 } + | 'entrypoints' ListCat { BNFC.Abs.Entryp $2 } + | 'separator' MinimumSize Cat String { BNFC.Abs.Separator $2 $3 $4 } + | 'terminator' MinimumSize Cat String { BNFC.Abs.Terminator $2 $3 $4 } + | 'delimiters' Cat String String Separation MinimumSize { BNFC.Abs.Delimiters $2 $3 $4 $5 $6 } + | 'coercions' Identifier Integer { BNFC.Abs.Coercions $2 $3 } + | 'rules' Identifier '::=' ListRHS { BNFC.Abs.Rules $2 $4 } + | 'define' Identifier ListArg '=' Exp { BNFC.Abs.Function $2 $3 $5 } + | 'layout' ListString { BNFC.Abs.Layout $2 } + | 'layout' 'stop' ListString { BNFC.Abs.LayoutStop $3 } + | 'layout' 'toplevel' { BNFC.Abs.LayoutTop } Item :: { BNFC.Abs.Item } -Item : String { BNFC.Abs.Terminal $1 } - | Cat { BNFC.Abs.NTerminal $1 } +Item + : String { BNFC.Abs.Terminal $1 } | Cat { BNFC.Abs.NTerminal $1 } ListItem :: { [BNFC.Abs.Item] } ListItem : {- empty -} { [] } | Item ListItem { (:) $1 $2 } Cat :: { BNFC.Abs.Cat } -Cat : '[' Cat ']' { BNFC.Abs.ListCat $2 } - | Identifier { BNFC.Abs.IdCat $1 } +Cat + : '[' Cat ']' { BNFC.Abs.ListCat $2 } + | Identifier { BNFC.Abs.IdCat $1 } ListCat :: { [BNFC.Abs.Cat] } -ListCat : {- empty -} { [] } - | Cat { (:[]) $1 } - | Cat ',' ListCat { (:) $1 $3 } +ListCat + : {- empty -} { [] } + | Cat { (:[]) $1 } + | Cat ',' ListCat { (:) $1 $3 } Label :: { BNFC.Abs.Label } -Label : Identifier { BNFC.Abs.Id $1 } - | '_' { BNFC.Abs.Wild } - | '[' ']' { BNFC.Abs.ListE } - | '(' ':' ')' { BNFC.Abs.ListCons } - | '(' ':' '[' ']' ')' { BNFC.Abs.ListOne } +Label + : Identifier { BNFC.Abs.Id $1 } + | '_' { BNFC.Abs.Wild } + | '[' ']' { BNFC.Abs.ListE } + | '(' ':' ')' { BNFC.Abs.ListCons } + | '(' ':' '[' ']' ')' { BNFC.Abs.ListOne } Arg :: { BNFC.Abs.Arg } Arg : Identifier { BNFC.Abs.Arg $1 } @@ -180,13 +191,14 @@ ListArg : {- empty -} { [] } | Arg ListArg { (:) $1 $2 } Separation :: { BNFC.Abs.Separation } -Separation : {- empty -} { BNFC.Abs.SepNone } - | 'terminator' String { BNFC.Abs.SepTerm $2 } - | 'separator' String { BNFC.Abs.SepSepar $2 } +Separation + : {- empty -} { BNFC.Abs.SepNone } + | 'terminator' String { BNFC.Abs.SepTerm $2 } + | 'separator' String { BNFC.Abs.SepSepar $2 } ListString :: { [String] } -ListString : String { (:[]) $1 } - | String ',' ListString { (:) $1 $3 } +ListString + : String { (:[]) $1 } | String ',' ListString { (:) $1 $3 } Exp :: { BNFC.Abs.Exp } Exp : Exp1 ':' Exp { BNFC.Abs.Cons $1 $3 } | Exp1 { $1 } @@ -195,18 +207,20 @@ Exp1 : Identifier ListExp2 { BNFC.Abs.App $1 $2 } | Exp2 { $1 } Exp2 :: { BNFC.Abs.Exp } -Exp2 : Identifier { BNFC.Abs.Var $1 } - | Integer { BNFC.Abs.LitInt $1 } - | Char { BNFC.Abs.LitChar $1 } - | String { BNFC.Abs.LitString $1 } - | Double { BNFC.Abs.LitDouble $1 } - | '[' ListExp ']' { BNFC.Abs.List $2 } - | '(' Exp ')' { $2 } +Exp2 + : Identifier { BNFC.Abs.Var $1 } + | Integer { BNFC.Abs.LitInt $1 } + | Char { BNFC.Abs.LitChar $1 } + | String { BNFC.Abs.LitString $1 } + | Double { BNFC.Abs.LitDouble $1 } + | '[' ListExp ']' { BNFC.Abs.List $2 } + | '(' Exp ')' { $2 } ListExp :: { [BNFC.Abs.Exp] } -ListExp : {- empty -} { [] } - | Exp { (:[]) $1 } - | Exp ',' ListExp { (:) $1 $3 } +ListExp + : {- empty -} { [] } + | Exp { (:[]) $1 } + | Exp ',' ListExp { (:) $1 $3 } ListExp2 :: { [BNFC.Abs.Exp] } ListExp2 : Exp2 { (:[]) $1 } | Exp2 ListExp2 { (:) $1 $2 } @@ -218,8 +232,9 @@ ListRHS : RHS { (:[]) $1 } | RHS '|' ListRHS { (:) $1 $3 } MinimumSize :: { BNFC.Abs.MinimumSize } -MinimumSize : 'nonempty' { BNFC.Abs.MNonempty } - | {- empty -} { BNFC.Abs.MEmpty } +MinimumSize + : 'nonempty' { BNFC.Abs.MNonempty } + | {- empty -} { BNFC.Abs.MEmpty } Reg :: { BNFC.Abs.Reg } Reg : Reg '|' Reg1 { BNFC.Abs.RAlt $1 $3 } | Reg1 { $1 } @@ -231,22 +246,26 @@ Reg2 : Reg2 Reg3 { BNFC.Abs.RSeq $1 $2 } | Reg3 { $1 } Reg3 :: { BNFC.Abs.Reg } -Reg3 : Reg3 '*' { BNFC.Abs.RStar $1 } - | Reg3 '+' { BNFC.Abs.RPlus $1 } - | Reg3 '?' { BNFC.Abs.ROpt $1 } - | 'eps' { BNFC.Abs.REps } - | Char { BNFC.Abs.RChar $1 } - | '[' String ']' { BNFC.Abs.RAlts $2 } - | '{' String '}' { BNFC.Abs.RSeqs $2 } - | 'digit' { BNFC.Abs.RDigit } - | 'letter' { BNFC.Abs.RLetter } - | 'upper' { BNFC.Abs.RUpper } - | 'lower' { BNFC.Abs.RLower } - | 'char' { BNFC.Abs.RAny } - | '(' Reg ')' { $2 } +Reg3 + : Reg3 '*' { BNFC.Abs.RStar $1 } + | Reg3 '+' { BNFC.Abs.RPlus $1 } + | Reg3 '?' { BNFC.Abs.ROpt $1 } + | 'eps' { BNFC.Abs.REps } + | Char { BNFC.Abs.RChar $1 } + | '[' String ']' { BNFC.Abs.RAlts $2 } + | '{' String '}' { BNFC.Abs.RSeqs $2 } + | 'digit' { BNFC.Abs.RDigit } + | 'letter' { BNFC.Abs.RLetter } + | 'upper' { BNFC.Abs.RUpper } + | 'lower' { BNFC.Abs.RLower } + | 'char' { BNFC.Abs.RAny } + | '(' Reg ')' { $2 } + { -happyError :: [Token] -> Either String a +type Err = Either String + +happyError :: [Token] -> Err a happyError ts = Left $ "syntax error at " ++ tokenPos ts ++ case ts of @@ -254,6 +273,8 @@ [Err _] -> " due to lexer error" t:_ -> " before `" ++ (prToken t) ++ "'" +myLexer :: String -> [Token] myLexer = tokens + } diff --git a/src/BNFC/PrettyPrint.hs b/src/BNFC/PrettyPrint.hs --- a/src/BNFC/PrettyPrint.hs +++ b/src/BNFC/PrettyPrint.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,6 +11,26 @@ ) where import Text.PrettyPrint + +-- | Overloaded function 'pretty'. + +class Pretty a where + pretty :: a -> Doc + prettyPrec :: Int -> a -> Doc + + {-# MINIMAL pretty | prettyPrec #-} + pretty = prettyPrec 0 + prettyPrec _ = pretty + +instance Pretty Int where pretty = text . show +instance Pretty Integer where pretty = text . show + +instance Pretty String where pretty = text + +-- | Render as 'String'. + +prettyShow :: Pretty a => a -> String +prettyShow = render . pretty -- | Put 'parens' around document if given condition is true. -- diff --git a/src/BNFC/Print.hs b/src/BNFC/Print.hs --- a/src/BNFC/Print.hs +++ b/src/BNFC/Print.hs @@ -1,8 +1,10 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} #if __GLASGOW_HASKELL__ <= 708 {-# LANGUAGE OverlappingInstances #-} #endif -{-# LANGUAGE FlexibleInstances #-} + {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- | Pretty-printer for BNFC. @@ -10,8 +12,16 @@ module BNFC.Print 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 BNFC.Abs -import Data.Char -- | The top-level printing method. @@ -24,19 +34,47 @@ doc = (:) render :: Doc -> String -render d = rend 0 (map ($ "") $ d []) "" where - rend i ss = case ss of - "[" :ts -> showChar '[' . rend i ts - "(" :ts -> showChar '(' . rend i ts - "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts - "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts - "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts - [";"] -> showChar ';' - ";" :ts -> showChar ';' . new i . rend i ts - t : ts@(p:_) | closingOrPunctuation p -> showString t . rend i ts - t :ts -> space t . rend i ts - _ -> id - new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace +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 -> 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 @@ -70,23 +108,26 @@ class Print a where prt :: Int -> a -> Doc - prtList :: Int -> [a] -> Doc - prtList i = concatD . map (prt i) instance {-# OVERLAPPABLE #-} Print a => Print [a] where - prt = prtList + prt i = concatD . map (prt i) instance Print Char where - prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'') - prtList _ s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"') + 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 '"') + mkEsc :: Char -> Char -> ShowS -mkEsc q s = case s of - _ | s == q -> showChar '\\' . showChar s - '\\'-> showString "\\\\" +mkEsc q = \case + s | s == q -> showChar '\\' . showChar s + '\\' -> showString "\\\\" '\n' -> showString "\\n" '\t' -> showString "\\t" - _ -> showChar s + s -> showChar s prPrec :: Int -> Int -> Doc -> Doc prPrec i j = if j < i then parenth else id @@ -98,61 +139,56 @@ prt _ x = doc (shows x) instance Print BNFC.Abs.Identifier where - prt _ (BNFC.Abs.Identifier (_,i)) = doc $ showString $ i - + prt _ (BNFC.Abs.Identifier (_,i)) = doc $ showString i instance Print BNFC.Abs.Grammar where - prt i e = case e of + prt i = \case BNFC.Abs.Grammar defs -> prPrec i 0 (concatD [prt 0 defs]) instance Print [BNFC.Abs.Def] where - prt = prtList + prt _ [] = concatD [] + prt _ [x] = concatD [prt 0 x] + prt _ (x:xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs] instance Print BNFC.Abs.Def where - prt i e = case e of + prt i = \case BNFC.Abs.Rule label cat items -> prPrec i 0 (concatD [prt 0 label, doc (showString "."), prt 0 cat, doc (showString "::="), prt 0 items]) - BNFC.Abs.Comment str -> prPrec i 0 (concatD [doc (showString "comment"), prt 0 str]) - BNFC.Abs.Comments str1 str2 -> prPrec i 0 (concatD [doc (showString "comment"), prt 0 str1, prt 0 str2]) + BNFC.Abs.Comment str -> prPrec i 0 (concatD [doc (showString "comment"), printString str]) + BNFC.Abs.Comments str1 str2 -> prPrec i 0 (concatD [doc (showString "comment"), printString str1, printString str2]) BNFC.Abs.Internal label cat items -> prPrec i 0 (concatD [doc (showString "internal"), prt 0 label, doc (showString "."), prt 0 cat, doc (showString "::="), prt 0 items]) BNFC.Abs.Token identifier reg -> prPrec i 0 (concatD [doc (showString "token"), prt 0 identifier, prt 0 reg]) BNFC.Abs.PosToken identifier reg -> prPrec i 0 (concatD [doc (showString "position"), doc (showString "token"), prt 0 identifier, prt 0 reg]) BNFC.Abs.Entryp cats -> prPrec i 0 (concatD [doc (showString "entrypoints"), prt 0 cats]) - BNFC.Abs.Separator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "separator"), prt 0 minimumsize, prt 0 cat, prt 0 str]) - BNFC.Abs.Terminator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "terminator"), prt 0 minimumsize, prt 0 cat, prt 0 str]) - BNFC.Abs.Delimiters cat str1 str2 separation minimumsize -> prPrec i 0 (concatD [doc (showString "delimiters"), prt 0 cat, prt 0 str1, prt 0 str2, prt 0 separation, prt 0 minimumsize]) + BNFC.Abs.Separator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "separator"), prt 0 minimumsize, prt 0 cat, printString str]) + BNFC.Abs.Terminator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "terminator"), prt 0 minimumsize, prt 0 cat, printString str]) + BNFC.Abs.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]) BNFC.Abs.Coercions identifier n -> prPrec i 0 (concatD [doc (showString "coercions"), prt 0 identifier, prt 0 n]) BNFC.Abs.Rules identifier rhss -> prPrec i 0 (concatD [doc (showString "rules"), prt 0 identifier, doc (showString "::="), prt 0 rhss]) BNFC.Abs.Function identifier args exp -> prPrec i 0 (concatD [doc (showString "define"), prt 0 identifier, prt 0 args, doc (showString "="), prt 0 exp]) BNFC.Abs.Layout strs -> prPrec i 0 (concatD [doc (showString "layout"), prt 0 strs]) BNFC.Abs.LayoutStop strs -> prPrec i 0 (concatD [doc (showString "layout"), doc (showString "stop"), prt 0 strs]) BNFC.Abs.LayoutTop -> prPrec i 0 (concatD [doc (showString "layout"), doc (showString "toplevel")]) - prtList _ [] = concatD [] - prtList _ [x] = concatD [prt 0 x] - prtList _ (x:xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs] - instance Print BNFC.Abs.Item where - prt i e = case e of - BNFC.Abs.Terminal str -> prPrec i 0 (concatD [prt 0 str]) + prt i = \case + BNFC.Abs.Terminal str -> prPrec i 0 (concatD [printString str]) BNFC.Abs.NTerminal cat -> prPrec i 0 (concatD [prt 0 cat]) - prtList _ [] = concatD [] - prtList _ (x:xs) = concatD [prt 0 x, prt 0 xs] instance Print [BNFC.Abs.Item] where - prt = prtList + prt _ [] = concatD [] + prt _ (x:xs) = concatD [prt 0 x, prt 0 xs] instance Print BNFC.Abs.Cat where - prt i e = case e of + prt i = \case BNFC.Abs.ListCat cat -> prPrec i 0 (concatD [doc (showString "["), prt 0 cat, doc (showString "]")]) BNFC.Abs.IdCat identifier -> prPrec i 0 (concatD [prt 0 identifier]) - prtList _ [] = concatD [] - prtList _ [x] = concatD [prt 0 x] - prtList _ (x:xs) = concatD [prt 0 x, doc (showString ","), prt 0 xs] instance Print [BNFC.Abs.Cat] where - prt = prtList + prt _ [] = concatD [] + prt _ [x] = concatD [prt 0 x] + prt _ (x:xs) = concatD [prt 0 x, doc (showString ","), prt 0 xs] instance Print BNFC.Abs.Label where - prt i e = case e of + prt i = \case BNFC.Abs.Id identifier -> prPrec i 0 (concatD [prt 0 identifier]) BNFC.Abs.Wild -> prPrec i 0 (concatD [doc (showString "_")]) BNFC.Abs.ListE -> prPrec i 0 (concatD [doc (showString "["), doc (showString "]")]) @@ -160,58 +196,56 @@ BNFC.Abs.ListOne -> prPrec i 0 (concatD [doc (showString "("), doc (showString ":"), doc (showString "["), doc (showString "]"), doc (showString ")")]) instance Print BNFC.Abs.Arg where - prt i e = case e of + prt i = \case BNFC.Abs.Arg identifier -> prPrec i 0 (concatD [prt 0 identifier]) - prtList _ [] = concatD [] - prtList _ (x:xs) = concatD [prt 0 x, prt 0 xs] instance Print [BNFC.Abs.Arg] where - prt = prtList + prt _ [] = concatD [] + prt _ (x:xs) = concatD [prt 0 x, prt 0 xs] instance Print BNFC.Abs.Separation where - prt i e = case e of + prt i = \case BNFC.Abs.SepNone -> prPrec i 0 (concatD []) - BNFC.Abs.SepTerm str -> prPrec i 0 (concatD [doc (showString "terminator"), prt 0 str]) - BNFC.Abs.SepSepar str -> prPrec i 0 (concatD [doc (showString "separator"), prt 0 str]) + BNFC.Abs.SepTerm str -> prPrec i 0 (concatD [doc (showString "terminator"), printString str]) + BNFC.Abs.SepSepar str -> prPrec i 0 (concatD [doc (showString "separator"), printString str]) instance Print [String] where - prt = prtList + prt _ [x] = concatD [printString x] + prt _ (x:xs) = concatD [printString x, doc (showString ","), prt 0 xs] instance Print BNFC.Abs.Exp where - prt i e = case e of + prt i = \case BNFC.Abs.Cons exp1 exp2 -> prPrec i 0 (concatD [prt 1 exp1, doc (showString ":"), prt 0 exp2]) BNFC.Abs.App identifier exps -> prPrec i 1 (concatD [prt 0 identifier, prt 2 exps]) BNFC.Abs.Var identifier -> prPrec i 2 (concatD [prt 0 identifier]) BNFC.Abs.LitInt n -> prPrec i 2 (concatD [prt 0 n]) BNFC.Abs.LitChar c -> prPrec i 2 (concatD [prt 0 c]) - BNFC.Abs.LitString str -> prPrec i 2 (concatD [prt 0 str]) + BNFC.Abs.LitString str -> prPrec i 2 (concatD [printString str]) BNFC.Abs.LitDouble d -> prPrec i 2 (concatD [prt 0 d]) BNFC.Abs.List exps -> prPrec i 2 (concatD [doc (showString "["), prt 0 exps, doc (showString "]")]) - prtList 2 [x] = concatD [prt 2 x] - prtList 2 (x:xs) = concatD [prt 2 x, prt 2 xs] - prtList _ [] = concatD [] - prtList _ [x] = concatD [prt 0 x] - prtList _ (x:xs) = concatD [prt 0 x, doc (showString ","), prt 0 xs] instance Print [BNFC.Abs.Exp] where - prt = prtList + 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 BNFC.Abs.RHS where - prt i e = case e of + prt i = \case BNFC.Abs.RHS items -> prPrec i 0 (concatD [prt 0 items]) - prtList _ [x] = concatD [prt 0 x] - prtList _ (x:xs) = concatD [prt 0 x, doc (showString "|"), prt 0 xs] instance Print [BNFC.Abs.RHS] where - prt = prtList + prt _ [x] = concatD [prt 0 x] + prt _ (x:xs) = concatD [prt 0 x, doc (showString "|"), prt 0 xs] instance Print BNFC.Abs.MinimumSize where - prt i e = case e of + prt i = \case BNFC.Abs.MNonempty -> prPrec i 0 (concatD [doc (showString "nonempty")]) BNFC.Abs.MEmpty -> prPrec i 0 (concatD []) instance Print BNFC.Abs.Reg where - prt i e = case e of + prt i = \case BNFC.Abs.RAlt reg1 reg2 -> prPrec i 0 (concatD [prt 0 reg1, doc (showString "|"), prt 1 reg2]) BNFC.Abs.RMinus reg1 reg2 -> prPrec i 1 (concatD [prt 1 reg1, doc (showString "-"), prt 2 reg2]) BNFC.Abs.RSeq reg1 reg2 -> prPrec i 2 (concatD [prt 2 reg1, prt 3 reg2]) @@ -220,11 +254,10 @@ BNFC.Abs.ROpt reg -> prPrec i 3 (concatD [prt 3 reg, doc (showString "?")]) BNFC.Abs.REps -> prPrec i 3 (concatD [doc (showString "eps")]) BNFC.Abs.RChar c -> prPrec i 3 (concatD [prt 0 c]) - BNFC.Abs.RAlts str -> prPrec i 3 (concatD [doc (showString "["), prt 0 str, doc (showString "]")]) - BNFC.Abs.RSeqs str -> prPrec i 3 (concatD [doc (showString "{"), prt 0 str, doc (showString "}")]) + BNFC.Abs.RAlts str -> prPrec i 3 (concatD [doc (showString "["), printString str, doc (showString "]")]) + BNFC.Abs.RSeqs str -> prPrec i 3 (concatD [doc (showString "{"), printString str, doc (showString "}")]) BNFC.Abs.RDigit -> prPrec i 3 (concatD [doc (showString "digit")]) BNFC.Abs.RLetter -> prPrec i 3 (concatD [doc (showString "letter")]) BNFC.Abs.RUpper -> prPrec i 3 (concatD [doc (showString "upper")]) BNFC.Abs.RLower -> prPrec i 3 (concatD [doc (showString "lower")]) BNFC.Abs.RAny -> prPrec i 3 (concatD [doc (showString "char")]) - diff --git a/src/BNFC/TypeChecker.hs b/src/BNFC/TypeChecker.hs --- a/src/BNFC/TypeChecker.hs +++ b/src/BNFC/TypeChecker.hs @@ -16,7 +16,7 @@ -- * Backdoor for rechecking defined syntax constructors for list types , checkDefinition' , buildSignature, buildContext, ctxTokens, isToken - , ListConstructors(LC) + , ListConstructors(..) ) where import Control.Monad @@ -25,11 +25,13 @@ import Data.Bifunctor import Data.Char +import Data.Either (partitionEithers) import qualified Data.Map as Map import qualified Data.Set as Set import BNFC.CF +import BNFC.PrettyPrint -- * Error monad @@ -54,9 +56,6 @@ -- * Types and context --- | Function arguments with type. -type Telescope = [(String, Base)] - data Context = Ctx { ctxLabels :: Signature -- ^ Types of labels, extracted from rules. , ctxTokens :: [String] -- ^ User-defined token types. @@ -64,25 +63,31 @@ } data ListConstructors = LC - { nil :: Base -> String - , cons :: Base -> String - } + { nil :: Base -> (String, Type) -- ^ 'Base' is the element type. 'Type' the list type. + , cons :: Base -> (String, Type) + } dummyConstructors :: ListConstructors -dummyConstructors = LC (const "[]") (const "(:)") - +dummyConstructors = LC + { nil = \ b -> ("[]" , FunT [] (ListT b)) + , cons = \ b -> ("(:)", FunT [b, ListT b] (ListT b)) + } -- * Type checker for definitions and expressions -- | Entry point. -checkDefinitions :: CF -> Err () +checkDefinitions :: CF -> Err CF checkDefinitions cf = do let ctx = buildContext cf - sequence_ [ checkDefinition ctx f xs e | FunDef f xs e <- cfgPragmas cf ] + let (pragmas, defs0) = partitionEithers $ map isFunDef $ cfgPragmas cf + defs <- mapM (checkDefinition ctx) defs0 + return cf { cfgPragmas = pragmas ++ map FunDef defs } -checkDefinition :: Context -> RFun -> [String] -> Exp -> Err () -checkDefinition ctx f xs e = - void $ checkDefinition' dummyConstructors ctx f xs e +checkDefinition :: Context -> Define -> Err Define +checkDefinition ctx (Define f args e0 _) = do + let xs = map fst args -- Throw away dummy types. + (tel, (e, b)) <- checkDefinition' dummyConstructors ctx f xs e0 + return $ Define f tel e b checkDefinition' :: ListConstructors -- ^ Translation of the list constructors. @@ -106,7 +111,7 @@ e' <- checkExp list (setLocals ctx $ zip xs ts) e t' return (zip xs ts, (e', t')) `catchError` \ err -> throwError $ - "In the definition " ++ unwords (f : xs ++ ["=",show e,";"]) ++ "\n " ++ err + "In the definition " ++ unwords (f : xs ++ ["=", prettyShow e, ";"]) ++ "\n " ++ err where f = wpThing ident plural 1 = "" @@ -114,32 +119,32 @@ checkExp :: ListConstructors -> Context -> Exp -> Base -> Err Exp checkExp list ctx = curry $ \case - (App "[]" [] , ListT t ) -> return (App (nil list t) []) - (App "[]" _ , _ ) -> throwError $ + (App "[]" _ [] , ListT t ) -> return (uncurry App (nil list t) []) + (App "[]" _ _ , _ ) -> throwError $ "[] is applied to too many arguments." - (App "(:)" [e,es], ListT t ) -> do + (App "(:)" _ [e,es], ListT t ) -> do e' <- checkExp list ctx e t es' <- checkExp list ctx es (ListT t) - return $ App (cons list t) [e',es'] + return $ uncurry App (cons list t) [e',es'] - (App "(:)" es , _ ) -> throwError $ + (App "(:)" _ es , _ ) -> throwError $ "(:) takes 2 arguments, but has been given " ++ show (length es) ++ "." - (e@(App x es) , t ) -> checkApp e x es t + (e@(App x _ es) , t ) -> checkApp e x es t (e@(Var x) , t ) -> e <$ checkApp e x [] t (e@LitInt{} , BaseT "Integer") -> return e (e@LitDouble{} , BaseT "Double" ) -> return e (e@LitChar{} , BaseT "Char" ) -> return e (e@LitString{} , BaseT "String" ) -> return e (e , t ) -> throwError $ - show e ++ " does not have type " ++ show t ++ "." + prettyShow e ++ " does not have type " ++ show t ++ "." where checkApp e x es t = do - FunT ts t' <- lookupCtx x ctx + ft@(FunT ts t') <- lookupCtx x ctx es' <- matchArgs ts - unless (t == t') $ throwError $ show e ++ " has type " ++ show t' ++ ", but something of type " ++ show t ++ " was expected." - return $ App x es' + unless (t == t') $ throwError $ prettyShow e ++ " has type " ++ show t' ++ ", but something of type " ++ show t ++ " was expected." + return $ App x ft es' where matchArgs ts | expect /= given = throwError $ "'" ++ x ++ "' takes " ++ show expect ++ " arguments, but has been given " ++ show given ++ "." diff --git a/src/BNFC/Utils.hs b/src/BNFC/Utils.hs --- a/src/BNFC/Utils.hs +++ b/src/BNFC/Utils.hs @@ -13,12 +13,13 @@ ( ModuleName , when, unless, unlessNull, unlessNull' , applyWhen, applyUnless - , for + , for, whenJust + , caseMaybe, (>.>) , curry3, uncurry3 - , singleton, mapHead, spanEnd - , duplicatesOn + , singleton, headWithDefault, mapHead, spanEnd + , duplicatesOn, groupOn, uniqOn , hasNumericSuffix - , (+++), (++++), (+-+), (+.+) + , (+++), (++++), (+-+), (+.+), parensIf , pad, table , mkName, mkNames, NameStyle(..) , lowerCase, upperCase, mixedCase @@ -28,6 +29,7 @@ , writeFileRep , cstring , getZonedTimeTruncatedToSeconds + , symbolToName ) where import Control.Arrow ((&&&)) @@ -36,6 +38,7 @@ import Data.Char import Data.List (intercalate) import Data.List.NonEmpty (pattern (:|), (<|)) +import Data.Map (Map) import Data.Semigroup (Semigroup(..)) import Data.Time @@ -47,7 +50,7 @@ import System.IO (IOMode(ReadMode),hClose,hGetContents,openFile) import System.IO.Error (tryIOError) -import BNFC.PrettyPrint hiding ((<>)) +import BNFC.PrettyPrint (Doc, text) type List1 = List1.NonEmpty @@ -100,10 +103,26 @@ [] -> mempty (a:as) -> k a as +-- * Flipped versions of standard functions. + +infixr 8 >.> + +-- | Diagrammatic composition. +(>.>) :: (a -> b) -> (b -> c) -> a -> c +g >.> f = f . g + -- | Non-monadic 'forM'. for :: [a] -> (a -> b) -> [b] for = flip map +-- | Generalization of 'forM' to 'Monoid'. +whenJust :: Monoid m => Maybe a -> (a -> m) -> m +whenJust = flip foldMap + +-- | Rotation of 'maybe'. +caseMaybe :: Maybe a -> b -> (a -> b) -> b +caseMaybe ma b f = maybe b f ma + -- * Tuple utilities. -- From https://hackage.haskell.org/package/extra-1.6.18/docs/Data-Tuple-Extra.html @@ -136,6 +155,12 @@ (+.+) :: String -> String -> String a +.+ b = a ++ "." ++ b +-- | Wrap in parentheses if condition holds. +parensIf :: Bool -> String -> String +parensIf = \case + True -> ("(" ++) . (++ ")") + False -> id + -- | Pad a string on the right by spaces to reach the desired length. pad :: Int -> String -> String pad n s = s ++ drop (length s) (replicate n ' ') @@ -163,6 +188,11 @@ singleton :: a -> [a] singleton = (:[]) +-- | Get the first element of a list, fallback for empty list. +headWithDefault :: a -> [a] -> a +headWithDefault a [] = a +headWithDefault _ (a:_) = a + -- | Apply a function to the head of a list. mapHead :: (a -> a) -> [a] -> [a] mapHead f = \case @@ -205,6 +235,19 @@ -- Partition elements by their normal form. . Fold.foldr (\ a -> Map.insertWith (<>) (nf a) (a :| [])) Map.empty +-- | Group consecutive elements that have the same normalform. +groupOn :: Eq b => (a -> b) -> [a] -> [List1 a] +groupOn nf = loop + where + loop = \case + [] -> [] + a:xs | let (as, rest) = span ((nf a ==) . nf) xs + -> (a :| as) : loop rest + +-- | Keep only the first of consecutive elements that have the same normalform. +uniqOn :: Eq b => (a -> b) -> [a] -> [a] +uniqOn nf = map List1.head . groupOn nf + -- | Get a numeric suffix if it exists. -- -- >>> hasNumericSuffix "hello world" @@ -283,6 +326,7 @@ | SnakeCase -- ^ e.g. @snake_case@ | CamelCase -- ^ e.g. @CamelCase@ | MixedCase -- ^ e.g. @mixedCase@ + | OrigCase -- ^ Keep original capitalization and form. deriving (Show, Eq) -- | Generate a name in the given case style taking into account the reserved @@ -332,6 +376,7 @@ "" -> "" c:cs -> toLower c:cs SnakeCase -> map toLower (intercalate "_" tokens) + OrigCase -> s capitalize [] = [] capitalize (c:cs) = toUpper c:cs @@ -464,7 +509,7 @@ -- ESCAPING --- | a function that renders a c-like string with escaped characters. +-- | A function that renders a c-like string with escaped characters. -- Note that although it's called cstring, this can be used with most (all) -- backend as they seem to mostly share escaping conventions. -- The c in the name is barely an homage for C being the oldest language in @@ -477,3 +522,113 @@ -- "foobar\"" cstring :: String -> Doc cstring = text . show + +-- * Symbols + +-- | Print a symbol as typical token name, like "(" as "LPAREN". + +symbolToName :: String -> Maybe String +symbolToName = (`Map.lookup` symbolTokenMap) + +-- | Map from symbol to token name. + +symbolTokenMap :: Map String String +symbolTokenMap = Map.fromList symbolTokenList + +-- | Association list from symbol to token name. + +symbolTokenList :: [(String, String)] +symbolTokenList = + [ ("{" , "LBRACE") + , ("}" , "RBRACE") + , ("(" , "LPAREN") + , (")" , "RPAREN") + , ("[" , "LBRACK") + , ("]" , "RBRACK") + , ("[]" , "EMPTYBRACK") + , ("." , "DOT") + , (".." , "DDOT") + , ("...", "ELLIPSIS") + , ("," , "COMMA") + , (",," , "DCOMMA") + , (";" , "SEMI") + , (";;" , "DSEMI") + , (":" , "COLON") + , ("::" , "DCOLON") + , (":=" , "COLONEQ") + , ("::=", "DCOLONEQ") + , (":-" , "COLONMINUS") + , ("::-", "DCOLONMINUS") + , (":--", "COLONDMINUS") + , ("+" , "PLUS") + , ("++" , "DPLUS") + , ("+=" , "PLUSEQ") + , ("+-" , "PLUSMINUS") + , ("-" , "MINUS") + , ("--" , "DMINUS") + , ("-=" , "MINUSEQ") + , ("-+" , "MINUSPLUS") + , ("-*" , "MINUSSTAR") + , ("*" , "STAR") + , ("**" , "DSTAR") + , ("*=" , "STAREQ") + , ("*-" , "STARMINUS") + , ("/" , "SLASH") + , ("//" , "DSLASH") + , ("/=" , "SLASHEQ") + , ("\\" , "BACKSLASH") + , ("\\\\","DBACKSLASH") + , ("/\\", "WEDGE") + , ("\\/", "VEE") + , ("&" , "AMP") + , ("&&" , "DAMP") + , ("&=" , "AMPEQ") + , ("|" , "BAR") + , ("||" , "DBAR") + , ("|=" , "BAREQ") + , ("<" , "LT") + , ("<<" , "DLT") + , ("<<<", "TLT") + , ("<=" , "LTEQ") + , ("<<=", "DLTEQ") + , ("<<<=","TLTEQ") + , (">" , "GT") + , (">>" , "DGT") + , (">>>", "TGT") + , (">=" , "GTEQ") + , (">>=", "DGTEQ") + , (">>>=","TGTEQ") + , ("<>" , "LTGT") + , ("=" , "EQ") + , ("==" , "DEQ") + , ("_" , "UNDERSCORE") + , ("!" , "BANG") + , ("!=" , "BANGEQ") + , ("?" , "QUESTION") + , ("?=" , "QUESTIONEQ") + , ("#" , "HASH") + , ("##" , "DHASH") + , ("###", "THASH") + , ("@" , "AT") + , ("@@" , "DAT") + , ("@=" , "ATEQ") + , ("$" , "DOLLAR") + , ("$$" , "DDOLLAR") + , ("%" , "PERCENT") + , ("%%" , "DPERCENT") + , ("%=" , "PERCENTEQ") + , ("^" , "CARET") + , ("^^" , "DCARET") + , ("^=" , "CARETEQ") + , ("~" , "TILDE") + , ("~~" , "DTILDE") + , ("~=" , "TILDEEQ") + , ("'" , "APOSTROPHE") + , ("''" , "DAPOSTROPHE") + , ("'''", "TAPOSTROPHE") + , ("<-" , "LARROW") + , ("->" , "RARROW") + , ("<=" , "LDARROW") + , ("=>" , "RDARROW") + , ("|->", "MAPSTO") + ] diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml new file mode 100644 --- /dev/null +++ b/stack-8.10.2.yaml @@ -0,0 +1,3 @@ +resolver: nightly-2020-12-14 +compiler: ghc-8.10.2 +compiler-check: match-exact diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml new file mode 100644 --- /dev/null +++ b/stack-8.10.3.yaml @@ -0,0 +1,3 @@ +resolver: lts-17.2 +compiler: ghc-8.10.3 +compiler-check: match-exact diff --git a/stack-8.10.4.yaml b/stack-8.10.4.yaml new file mode 100644 --- /dev/null +++ b/stack-8.10.4.yaml @@ -0,0 +1,3 @@ +resolver: lts-17.13 +compiler: ghc-8.10.4 +compiler-check: match-exact diff --git a/stack-8.10.yaml b/stack-8.10.yaml deleted file mode 100644 --- a/stack-8.10.yaml +++ /dev/null @@ -1,3 +0,0 @@ -resolver: lts-18.28 -compiler: ghc-8.10.7 -compiler-check: newer-minor diff --git a/stack-8.2.2.yaml b/stack-8.2.2.yaml new file mode 100644 --- /dev/null +++ b/stack-8.2.2.yaml @@ -0,0 +1,1 @@ +resolver: lts-11.22 diff --git a/stack-8.2.yaml b/stack-8.2.yaml deleted file mode 100644 --- a/stack-8.2.yaml +++ /dev/null @@ -1,1 +0,0 @@ -resolver: lts-11.22 diff --git a/stack-8.4.4.yaml b/stack-8.4.4.yaml new file mode 100644 --- /dev/null +++ b/stack-8.4.4.yaml @@ -0,0 +1,1 @@ +resolver: lts-12.26 diff --git a/stack-8.4.yaml b/stack-8.4.yaml deleted file mode 100644 --- a/stack-8.4.yaml +++ /dev/null @@ -1,1 +0,0 @@ -resolver: lts-12.26 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml new file mode 100644 --- /dev/null +++ b/stack-8.6.4.yaml @@ -0,0 +1,2 @@ +resolver: lts-13.19 + diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml new file mode 100644 --- /dev/null +++ b/stack-8.6.5.yaml @@ -0,0 +1,1 @@ +resolver: lts-14.27 diff --git a/stack-8.6.yaml b/stack-8.6.yaml deleted file mode 100644 --- a/stack-8.6.yaml +++ /dev/null @@ -1,1 +0,0 @@ -resolver: lts-14.27 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml new file mode 100644 --- /dev/null +++ b/stack-8.8.2.yaml @@ -0,0 +1,2 @@ +resolver: lts-15.3 + diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml new file mode 100644 --- /dev/null +++ b/stack-8.8.3.yaml @@ -0,0 +1,2 @@ +resolver: lts-15.8 + diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml new file mode 100644 --- /dev/null +++ b/stack-8.8.4.yaml @@ -0,0 +1,4 @@ +resolver: lts-16.2 +compiler: ghc-8.8.4 +compiler-check: match-exact + diff --git a/stack-8.8.yaml b/stack-8.8.yaml deleted file mode 100644 --- a/stack-8.8.yaml +++ /dev/null @@ -1,3 +0,0 @@ -resolver: lts-16.31 -compiler: ghc-8.8.4 -compiler-check: newer-minor diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml new file mode 100644 --- /dev/null +++ b/stack-9.0.1.yaml @@ -0,0 +1,33 @@ +resolver: ghc-9.0.1 +compiler: ghc-9.0.1 +# compiler-check: match-exact + +extra-deps: +- alex-3.2.6 +- cabal-doctest-1.0.8 +- happy-1.20.0 +- string-qq-0.0.4 + +# For --test: +- HUnit-1.6.2.0 +- QuickCheck-2.14.2 +- ansi-terminal-0.11 +- base-compat-0.11.2 +- call-stack-0.4.0 +- clock-0.8.2 +- code-page-0.2.1 +- colour-2.3.5 +- doctest-0.18.1 +- ghc-paths-0.1.0.12@rev:2 +- hspec-2.8.2 +- hspec-core-2.8.2 +- hspec-discover-2.8.2 +- hspec-expectations-0.8.2 +- primitive-0.7.1.0 +- quickcheck-io-0.2.0 +- random-1.2.0 +- setenv-0.1.1.3 +- splitmix-0.1.0.3 +- syb-0.7.2.1 +- temporary-1.3 +- tf-random-0.5 diff --git a/stack-9.0.yaml b/stack-9.0.yaml deleted file mode 100644 --- a/stack-9.0.yaml +++ /dev/null @@ -1,3 +0,0 @@ -resolver: lts-19.33 -compiler: ghc-9.0.2 -compiler-check: newer-minor diff --git a/stack-9.10.yaml b/stack-9.10.yaml deleted file mode 100644 --- a/stack-9.10.yaml +++ /dev/null @@ -1,1 +0,0 @@ -resolver: lts-24.15 diff --git a/stack-9.12.yaml b/stack-9.12.yaml deleted file mode 100644 --- a/stack-9.12.yaml +++ /dev/null @@ -1,3 +0,0 @@ -resolver: nightly-2025-10-14 -compiler: ghc-9.12.2 -compiler-check: newer-minor diff --git a/stack-9.2.yaml b/stack-9.2.yaml deleted file mode 100644 --- a/stack-9.2.yaml +++ /dev/null @@ -1,3 +0,0 @@ -resolver: lts-20.26 -compiler: ghc-9.2.8 -compiler-check: newer-minor diff --git a/stack-9.4.yaml b/stack-9.4.yaml deleted file mode 100644 --- a/stack-9.4.yaml +++ /dev/null @@ -1,3 +0,0 @@ -resolver: lts-21.25 -compiler: ghc-9.4.8 -compiler-check: newer-minor diff --git a/stack-9.6.yaml b/stack-9.6.yaml deleted file mode 100644 --- a/stack-9.6.yaml +++ /dev/null @@ -1,3 +0,0 @@ -resolver: lts-22.44 -compiler: ghc-9.6.7 -compiler-check: newer-minor diff --git a/stack-9.8.yaml b/stack-9.8.yaml deleted file mode 100644 --- a/stack-9.8.yaml +++ /dev/null @@ -1,6 +0,0 @@ -resolver: lts-23.28 -compiler: ghc-9.8.4 -compiler-check: newer-minor - -packages: -- . diff --git a/test/BNFC/CFSpec.hs b/test/BNFC/CFSpec.hs --- a/test/BNFC/CFSpec.hs +++ b/test/BNFC/CFSpec.hs @@ -56,18 +56,3 @@ sameCat (Cat "Abc") (CoercCat "Abc" 44) `shouldBe` True it "considers Foo and Bar to not be the same" $ sameCat (Cat "Foo") (Cat "Bar") `shouldBe` False - - describe "getSeparatorByPrecedence" $ do - let c0 = CoercCat "C" 0 - c1 = CoercCat "C" 1 - rule0 = Rule (noPosition "(:)") (noPosition $ ListCat c0) [Left c0, Right ",", Left (ListCat c0)] Parsable - rule1 = Rule (noPosition "(:)") (noPosition $ ListCat c1) [Left c1, Right ";", Left (ListCat c1)] Parsable - - it "returns a single value for a simple list" $ - getSeparatorByPrecedence [rule0] `shouldBe` [(0,",")] - - it "returns as many separators as there are list constructors" $ - getSeparatorByPrecedence [rule0, rule1] `shouldBe` [(1,";"),(0,",")] - - it "ignores additional rules with the same precedence" $ - getSeparatorByPrecedence [rule0, rule1, rule0] `shouldBe` [(1,";"),(0,",")]