haskell-src-exts-1.14.0/0000755000000000000000000000000012204617771013163 5ustar0000000000000000haskell-src-exts-1.14.0/LICENSE0000644000000000000000000001077612204617765014206 0ustar0000000000000000This library (Haskell Source eXtensions) is derived from code from several sources: * Code from the GHC project which is largely (c) The University of Glasgow, and distributable under a BSD-style license (see below), * Code from the Haskell 98 Report which is (c) Simon Peyton Jones and freely redistributable (but see the full license for restrictions). The full text of these licenses is reproduced below. All of the licenses are BSD-style or compatible. ----------------------------------------------------------------------------- The haskell-src-exts package itself is distributable under the modified BSD license: Copyright (c) 2005, Niklas Broberg All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of its contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------- The Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------- Code derived from the document "Report on the Programming Language Haskell 98", is distributed under the following license: Copyright (c) 2002 Simon Peyton Jones The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Language. ----------------------------------------------------------------------------- haskell-src-exts-1.14.0/CHANGELOG0000644000000000000000000003153012204617765014402 0ustar0000000000000000** 1.14.x 1.13.6 --> 1.14.0 =============== * Modernize the Extension datatype in L.H.E.Extension, following the lead of Cabal, to allow negative and positive extension modifiers (turning features on and off). You need to worry about backwards-incompatible changes if any of the following pertains to you: 1) If you use the Extension datatype programmatically - it has changed significantly (see documentation). 2) The ParseMode record now has one more field (baseLanguage :: Language), which might give you a type error. 3) The behavior of the (extensions :: [Extension]) field has changed, which could bite you if you pass custom extensions in the ParseMode. Previously, the ParseMode defaulted to the list of extensions accepted by Haskell2010, and if you set the list explicitly you would override this. Now, the defaults are { baseLanguage = Haskell2010, extensions = [] }, and explicitly setting a list of extensions will be interpreted on top of Haskell2010. See further the documentation for L.H.E.Extension. * Add support for the 'capi' calling convention. It is enabled with the CApiFFI extension. It's been included since GHC 7.4, and advertised since 7.6. * Add support for the 'interruptible' FFI safety annotation, enabled with the InterruptibleFFI extension. * Give better error message when lexing newline fails. In particular, fix the bug when the parser would crash if the file didn't end with a newline. * Support unboxed tuple expressions and patterns. * Fix bug in lexing of primitive integer literals in hex or octal notation. * Disallow negative primitive word literals (such as W# (-0x8000000000000000##)). * Allow phase control for SPECIALIZE pragma. * Derive Foldable and Traversable instances for all annotated AST types. * Fix bug with pretty-printing WARNING and DEPRECATED pragmas. ** 1.13.x 1.13.5 --> 1.13.6 =============== * Allow 0-parameter type classes when MultiParamTypeClasses is on. * Add support for NondecreasingIndentation. Previously it was always on, which is the default behavior in GHC. Now it is on only if enabled, or when using the newly added ghcDefaults extension set (instead of haskell2010). 1.13.4 --> 1.13.5 =============== * Expose Language.Haskell.Exts.Lexer, which implements a standalone token stream lexer. The module is re-exported both by Language.Haskell.Exts and by Language.Haskell.Exts.Annotated. 1.13.3 --> 1.13.4 =============== * Fix bug where operators starting with # written in parentheses would not be parsed when UnboxedTuples is turned on. Now works. * Allow 'family' and 'forall' as (non-type) varid's. This adds one more shift/reduce conflict to the parser, and its resolution means that '{-# RULES "name" forall = ... #-}' is not allowed. * Complete the set of FFI calling conventions from the Haskell 2010 report (even if no compiler implements them). Also include the 'js' calling convention, supported by UHC. 1.13.2 --> 1.13.3 =============== * Fundep premises are now allowed to be empty. * Fix the bug where the lexer would crash on a LINE pragma that did not include a line number. * Fix the bug where the lexer would require the # of a MagicHash-style type constructor to be succeeded by at least one character in the file. * Fix long-standing bug where the parser would crash with an ugly "Internal error" error message if encountering an extra }. * Report errors at the right place for function arity mismatches. Earlier they were reported at end of file, now they are reported where the function is declared. * Lexer now properly fails on line-breaks in string literals. * Lexer now handles character escapes up to 0x10FFFF (unicode). 1.13.1 --> 1.13.2 =============== * Fix the bug with the precedence of unary prefix minus. Previously it was resolved as binding more tightly than any infix operator, now it is correctly treated as having the same fixity as binary infix minus. 1.13.0 --> 1.13.1 =============== * Allow an optional semi before the closing tag of an element. This achieves a similar effect for XmlSyntax in do blocks as DoAndIfThenElse does for the if construct. No more need to indent the closing tag one step further than the opening tag. * Add a dummy 'noLoc :: SrcLoc' to L.H.E.SrcLoc, to use when generating code. It could definitely be done more elegantly, but not without inducing another major version bump, so later. * Fix a regression from 1.11.x where the parser would crash upon encountering non-simple class/data declaration heads, e.g. 'data A [a]'. Now fails with a parse error as intended. 1.12.0 --> 1.13.0 =============== * Add extensions DoAndIfThenElse and NPlusKPatterns to Language.Haskell.Exts.Extensions. * DoAndIfThenElse is now supported, at long last, making HSE compatible with Haskell2010 * Introduce haskell98 and haskell2010 extension groups, exported from Language.Haskell.Exts.Extensions. * Backwards-incompatible change: default parse mode is now to use haskell2010, which means the following features are recognized by default: DoAndIfThenElse, PatternGuards, ForeignFunctionInterface, EmptyDataDecls. NPlusKPatterns is no longer recognized by default. ** 1.12.x 1.11.1 --> 1.12.0 =============== * Move from old [$...| quasi-quote syntax to the new [...| one. The old syntax is still recognized while parsing. * Allow symbols as variables when TypeOperators is enabled. * Rename ExplicitForall in ExplicitForAll, to be consistent with GHC and the Haskell' process. ** 1.11.x 1.10.2 --> 1.11.1 =============== * API change: the fixities field in ParseMode is now of type Maybe [Fixity]. If the field is Nothing the parsing will not try to do any fixity resolution whatsoever, otherwise it behaves as before. * API change, bug fix: The Fixity type contains a QName rather than an Op to name the operator. The operator must match the given QName exactly (i.e., unqualified names only match unqualified names, and qualified names only match qualified names) for applyFixities to perform fixups. * Bug fix: End-of-file inside an OPTIONS pragma no longer loops. ** 1.10.x 1.10.1 --> 1.10.2 =============== * Fix a missing case in the Functor declaration for Decl. Thanks to Malcolm Wallace for the patch! 1.10.0 --> 1.10.1 =============== * Enable the unicode version of DoubleColon (x2237). Thanks to Andrés Sicard-Ramírez for the patch! 1.9.6 --> 1.10.0 =============== * Ensure that implied extensions are always picked up, not only when using the parseFile* family of functions as previously. * Add the newly devised <%>... syntax to the XmlSyntax support. This causes changes to pretty much everything, including adding a case to the AST which prompts the major version bump. ** 1.9.x 1.9.5 --> 1.9.6 =============== * Fix a bug (#203) where the lexer loops on malformed quasi-quoters. * Fix a bug with pretty-printing RULES pragmas. 1.9.4 --> 1.9.5 =============== * Fix a bug where deriving clauses for GADT-style data declarations were not properly indented. * Pretty-printing patterns is now more accurate in inserting (and not inserting) parentheses when needed. 1.9.3 --> 1.9.4 =============== * Pretty-printer now inserts parentheses in clever places when printing kinds. * Pretty-printing expressions is now far more accurate in inserting (and not inserting) parentheses when needed. * Pretty-printing negative expressions no longer inserts a superfluous space between the - and the expression. 1.9.2 --> 1.9.3 =============== * Constructors for newtype declarations must now have exactly one argument. This is only when using the classic syntax, not with GADT-style syntax. * Fix a bug where preceding commas in tuple sections were counted one too few. 1.9.1 --> 1.9.2 =============== * Fix a bug with pretty-printing lexer tokens. * Fix a bug where non-colon TypeOperators could not be used in prefix mode. 1.9.0 --> 1.9.1 =============== * Export parseFileContentsWithExts from .Exts. 1.8.2 --> 1.9.0 =============== * OptionPragma is renamed to the more descriptive ModulePragma, and adds a constructor AnnModulePragma for handling ANN pragmas preceding module header. * Add instances for Eq/Ord/Data/Typeable for Fixity. * Add 'parseFileWithComments' and 'parseFileContentsWithComments' to L.H.Exts . * More informative error messages when HSX tags are mismatched. ** 1.8.x 1.8.1 --> 1.8.2 =============== * Don't insert redundant parentheses around record constructions and updates. 1.8.0 --> 1.8.1 =============== * Fix three bugs with the handling of ANN. I must have been really tired when implementing that support. 1.7.2 --> 1.8.0 =============== * Add an instance Show Fixity (derived). * Support for the new ANN and INLINE_CONLIKE pragmas. * Export knownExtensions from .Extension. * Remove support for CFILES and INCLUDE pragmas. The support wasn't correct anyway, as it assumed the pragmas appeared at the top of files. As CFILES/INCLUDE pragmas can (and do) appear anywhere, there's no hope to support them in the AST. Better to remove the support altogether. Files with CFILES/INCLUDE pragmas can still be parsed of course, but those pragmas will be handled as comments. * Parsing with ignoreLinePragmas = False now correctly updates the file name. * Allow the whole SPECIALISE/INLINE family of pragmas in instance declarations. The InsInline constructor is removed, and is now represented by InsDecl (InlineSig ...). * Fix a bug with line numbering and quasi quotes, and a similar one with line numbering and CDATA. * Fix a few minor bugs in the exactPrinter. * Fix the strange handling of so called strings in LINE pragmas. ** 1.7.x 1.7.1 --> 1.7.2 =============== * Fixes a bug in lexing LINE pragmas (used when ignoreLinePragmas is set to False). 1.7.0 --> 1.7.1 =============== * UnicodeSyntax now also enables the forall symbol (U+2200). 1.6.1 --> 1.7.0 =============== * Operators defined on the form (a `op` b) c = ... could not be handled by the (annotated) AST, nor the parser. I had to change the definition of the AST node for InfixMatch to allow a list of right-hand subpatterns, i.e. InfixMatch l (Pat l) (Name l) (Pat l) ... has become InfixMatch l (Pat l) (Name l) [Pat l] ... I also had an epiphany and fixed the issue that would arise with exact printing of prefix definitions including parentheses, so that now works too! ** 1.6.x 1.6.0 --> 1.6.1 =============== * UnicodeSyntax now works not only for identifiers, but also for ->, <- and =>, as well as Arrows arrows and kind stars. 1.5.3 --> 1.6.0 =============== * (=~=) turns out to be too general at Functor (for intuitive and not technical reasons), so is specialised to Annotated to closer mirror the original intention. * applyFixities is hoisted to a monad, and now fails on ambiguous infix expressions. ** 1.5.x 1.5.2 --> 1.5.3 =============== * Several small bug fixes in the exact printer, and fail more gracefully if the number of srcInfoPoints doesn't match the needs of the node. 1.5.1 --> 1.5.2 =============== * Fix a bug in the exact printer that made it always print the first token at position (0,0). * In fixing the above, Annotated is now a superclass of ExactP. It was already a superclass in spirit, and nothing can break from this since ExactP is only exported abstractly. 1.5.0 --> 1.5.1 =============== * The pretty printer now introduces parentheses for non-atomic arguments to function application. Note that infix applications are left untouched, no parentheses will be inserted there, as it is assumed that fixities are already properly resolved. * Fix a bug in the pretty printer where view patterns and n+k patterns were not properly parenthesised. 1.4.0 --> 1.5.0 =============== * Add support for acting on LINE pragmas while parsing, i.e. updating the source position according to info given in LINE pragmas. This is done conditionally based on a new flag ignoreLinePragmas in the ParseMode, hence the need to increase the major version. ** 1.4.x 1.3.5 --> 1.4.0 =============== * The AST node for Proc in the simple AST is changed to include a SrcLoc argument, to make it consistent with similar nodes e.g. Lambda. This is specifically needed for transformation of patterns in HSX. ** 1.3.x 1.3.4 --> 1.3.5 =============== * Added an entry point in the parser for statements, and an instance Parseable Stmt to go with it. * Ensured that .Annotated exports all relevant parseXXX(WithYYY) functions. 1.3.3 --> 1.3.4 =============== * Operator fixities are now resolved in patterns. 1.3.2 --> 1.3.3 =============== * Fixes a bug where qualified keywords are rejected even if the extension that enables the keyword in question is not turned on. 1.3.0 --> 1.3.2 =============== (Let's forget 1.3.1 ever existed.) * Fix a bug where declarations of infix operators were not properly merged as FunBinds. haskell-src-exts-1.14.0/haskell-src-exts.cabal0000644000000000000000000001516712204617771017352 0ustar0000000000000000Name: haskell-src-exts Version: 1.14.0 License: BSD3 License-File: LICENSE Author: Niklas Broberg Maintainer: Niklas Broberg Category: Language Synopsis: Manipulating Haskell source: abstract syntax, lexer, parser, and pretty-printer Description: Haskell-Source with Extensions (HSE, haskell-src-exts) is an extension of the standard haskell-src package, and handles most registered syntactic extensions to Haskell, including: . * Multi-parameter type classes with functional dependencies . * Indexed type families (including associated types) . * Empty data declarations . * GADTs . * Implicit parameters . * Template Haskell . and a few more. All extensions implemented in GHC are supported. Apart from these standard extensions, it also handles regular patterns as per the HaRP extension as well as HSX-style embedded XML syntax. Homepage: https://github.com/haskell-suite/haskell-src-exts Stability: Stable Tested-with: GHC==6.10.2, GHC==6.10.4, GHC==6.12.3, GHC==7.0.2 Build-Type: Custom Cabal-Version: >= 1.10 Extra-Source-Files: CHANGELOG Test/examples/ArityMismatch.hs Test/examples/ArrowLayout.hs Test/examples/Attributes.hs Test/examples/BadStringLineBreak.hs Test/examples/BangPatterns.hs Test/examples/Bug.hs Test/examples/ByteStringUtils.hs Test/examples/ClassInstType.hs Test/examples/ConstraintKinds.hs Test/examples/CParser.hs Test/examples/CStyleLinePragmas.hs Test/examples/DataHeadParen.hs Test/examples/Directory.hs Test/examples/DoRec.hs Test/examples/DoubleHashOp.hs Test/examples/EmptyAnn.hs Test/examples/EmptyContext.hs Test/examples/EmptyFunDepPremise.hs Test/examples/EmptyInstance.hs Test/examples/EmptyList.hs Test/examples/ExtraEndBrace.hs Test/examples/FamilyKindSig.hs Test/examples/FamilyVarid.hs Test/examples/FFIExtensions.hs Test/examples/FixityTests.hs Test/examples/ForallInInstance.hs Test/examples/ForeignImport.hs Test/examples/GadtDeriving.hs Test/examples/GADTRecord.hs Test/examples/GenericTree.hs Test/examples/GhcDeriving.hs Test/examples/GroupKeyword.hs Test/examples/HappyDoAction.hs Test/examples/HaskellParser.hs Test/examples/HexPrec.hs Test/examples/IfThenElseLayout.hs Test/examples/IllDataTypeDecl.hs Test/examples/IndentedWhereBlock.hs Test/examples/IndentedWhere.hs Test/examples/InfixParser.hs Test/examples/LambdaCase.hs Test/examples/LineOptionsPragma.hs Test/examples/MultiCtxt.hs Test/examples/MultiWayIf.hs Test/examples/NegPrimWordLiteral.hs Test/examples/NestedAsPat.hs Test/examples/NonDecreasing.hs Test/examples/NPlusK.hs Test/examples/ParallelListComp.hs Test/examples/ParenFunBind.hs Test/examples/PrimitiveIntHexLiteral.hs Test/examples/QQType.hs Test/examples/QualifiedDot.hs Test/examples/QuasiQuoteLines.hs Test/examples/QuasiQuoteOld.hs Test/examples/QuasiQuoteSplice.hs Test/examples/RCategory.lhs Test/examples/ReadP.hs Test/examples/RealGHC.lhs Test/examples/RecordInfixSelector.hs Test/examples/RelaxedDo.hs Test/examples/SCCPragmas.hs Test/examples/ScopedTypeVariables.hs Test/examples/SimpleDeriving.hs Test/examples/SingleClassAsst.hs Test/examples/SpecializeInstance.hs Test/examples/SpecializePhaseControl.hs Test/examples/Testing.hs Test/examples/THTypes.hs Test/examples/TupleSections.hs Test/examples/TypeFunctions.hs Test/examples/TypeOperatorAsVariable.hs Test/examples/TypeOperatorsTest.hs Test/examples/UnboxedSingleton.hs Test/examples/UnboxedTuples.hs Test/examples/Unicode.hs Test/examples/UnicodeSyntax.hs Test/examples/UnindentedPragmaClose.hs Test/examples/WhereBlock.hs Test/failing.txt Test/printFail.txt Test/Runner.hs Flag base4 Library Default-language: Haskell98 Build-Tools: happy >= 1.17 Build-Depends: array >= 0.1, pretty >= 1.0, cpphs >= 1.3 if flag(base4) Build-depends: base >= 4 && < 5 cpp-options: -DBASE4 else Build-depends: base >= 3 && < 4 Exposed-modules: Language.Haskell.Exts, Language.Haskell.Exts.Lexer, Language.Haskell.Exts.Parser, Language.Haskell.Exts.Pretty, Language.Haskell.Exts.Syntax, Language.Haskell.Exts.Extension, Language.Haskell.Exts.Build, Language.Haskell.Exts.Fixity, Language.Haskell.Exts.Comments, Language.Haskell.Exts.SrcLoc, Language.Haskell.Exts.Annotated, Language.Haskell.Exts.Annotated.Syntax, Language.Haskell.Exts.Annotated.Fixity, Language.Haskell.Exts.Annotated.Build, Language.Haskell.Exts.Annotated.ExactPrint, Language.Haskell.Exts.Annotated.Simplify Other-modules: Language.Haskell.Exts.ExtScheme, Language.Haskell.Exts.ParseMonad, Language.Haskell.Exts.ParseSyntax, Language.Haskell.Exts.InternalLexer, Language.Haskell.Exts.ParseUtils, Language.Haskell.Exts.InternalParser Hs-source-dirs: src Source-Repository head Type: git Location: https://github.com/haskell-suite/haskell-src-exts.git Test-Suite test type: exitcode-stdio-1.0 main-is: Test/Runner.hs GHC-Options: -threaded Default-language: Haskell2010 Build-depends: base < 5, haskell-src-exts, smallcheck >= 1.0, tasty, tasty-smallcheck, tasty-hunit, filepath, directory haskell-src-exts-1.14.0/Setup.hs0000644000000000000000000000005612204617771014620 0ustar0000000000000000import Distribution.Simple main = defaultMain haskell-src-exts-1.14.0/Test/0000755000000000000000000000000012204617765014105 5ustar0000000000000000haskell-src-exts-1.14.0/Test/failing.txt0000644000000000000000000000234412204617765016262 0ustar0000000000000000GADTRecord.hs GADT records not yet supported. DoRec.hs DoRec not yet supported. CStyleLinePragmas.hs Shouldn't succeed. HSE does not and will not support C-style line pragmas. QuasiQuoteSplice.hs Splicing inside quasi-quotes fails ExtraEndBrace.hs Should fail - but gracefully ArityMismatch.hs Should fail - but give error message in the right place ForallInInstance.hs Bug - needs AST change BadStringLineBreak.hs Shouldn't succeed. NonDecreasing.hs Shouldn't succeed without -XNondecreasingIndentation. THTypes.hs Type splices not yet supported QQType.hs Same issue as above UnicodeSyntax.hs Unicode forall symbol not working IllDataTypeDecl.hs Parser doesn't handle all declaration heads ConstraintKinds.hs ConstraintKinds in type synonyms not yet supported. RCategory.lhs ConstraintKinds not supported in general. IndentedWhereBlock.hs Bug - needs fixes to layout parsing NegPrimWordLiteral.hs Primitive word literals cannot be negative. RecordPuns.hs Qualified record puns not yet supported. IndentedTopLevelWhere.hs Weird layout bug. MultiWayIf.hs Multi-way if statements not yet supported. LambdaCase.hs Lambda-case expressions not yet supported. haskell-src-exts-1.14.0/Test/Runner.hs0000644000000000000000000001037412204617765015717 0ustar0000000000000000-- | Use "runhaskell Setup.hs test" or "cabal test" to run these tests. {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving #-} module Main where import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.SmallCheck import Test.SmallCheck import Test.SmallCheck.Series import Language.Haskell.Exts.Annotated import System.IO import Control.Monad import Control.Applicative import Data.List import Data.Char import Data.Function import System.Directory import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath main :: IO () main = do files <- getDirectoryContents examplesDir defaultMain . testGroup "Tests" =<< sequence [ parserTests files , printerTests files , return extProperties ] -- | Where all the tests are to be found examplesDir :: FilePath examplesDir = "Test" "examples" getParserFailing, getPrinterFailing :: IO [FilePath] (getParserFailing, getPrinterFailing) = (get "failing.txt", get "printFail.txt") where get fname = liftM (map (head . words) . lines) . readFile $ "Test" fname parserTests :: [FilePath] -> IO TestTree parserTests files = testGroup "Parser tests" <$> do failing <- getParserFailing return [check (x `elem` failing) (examplesDir x) | x <- files, not $ "." `isPrefixOf` x] check :: Bool -> FilePath -> TestTree check expected file = testCase file $ do res <- parseFile file case res of ParseOk x | expected -> assertFailure $ "Unexpected pass for " ++ file | otherwise -> return () err | expected -> return () | otherwise -> assertFailure $ "Failure when parsing " ++ show file ++ "\n" ++ show err printerTests :: [FilePath] -> IO TestTree printerTests files = testGroup "Exact printer tests" <$> do parserFailing <- getParserFailing printerFailing <- getPrinterFailing return [ roundTrip (x `elem` printerFailing) (examplesDir x) | x <- files , not $ "." `isPrefixOf` x , not $ x `elem` parserFailing ] roundTrip :: Bool -> FilePath -> TestTree roundTrip expected file = testCase file $ do fc <- readFile file pr <- parseFileWithComments (defaultParseMode { parseFilename = file }) file case pr of ParseOk (ast,cs) -> do let res = exactPrint ast cs xs = dropWhile (uncurry (==)) $ zip (map (reverse . dropWhile isSpace . reverse) $ lines fc) (map (reverse . dropWhile isSpace . reverse) $ lines res) case xs of [] | expected -> assertFailure $ "Unexpected pass for " ++ file | otherwise -> return () (lfc, lres):_ | expected -> return () | otherwise -> assertFailure $ unlines [ "Result of print does not match input when printing " ++ show file , "First unmatching lines are (line length):" , " Input (" ++ show (length lfc) ++ "): " ++ lfc , " Result (" ++ show (length lres) ++ "): " ++ lres ] err -> assertFailure $ "Failure when parsing " ++ show file ++ "\n" ++ show err instance Monad m => Serial m Language where series = generate (const knownLanguages) instance Monad m => Serial m Extension where series = generate (const knownExtensions) instance Monad m => Serial m KnownExtension where series = generate $ const [ e | EnableExtension e <- knownExtensions ] infix 3 ~~ (~~) :: Monad m => [Extension] -> [Extension] -> Property m xts1 ~~ xts2 = forAll $ \lang -> ((==) `on` sort . toExtensionList lang) xts1 xts2 extProperties = localOption (SmallCheckDepth 2) $ testGroup "Properties of LANGUAGE extensions" $ [ testProperty "identity" $ \x -> x ~~ x , testProperty "idempotence" $ \x -> x ++ x ~~ x , testProperty "right bias" $ \x y -> x ++ y ++ x ~~ y ++ x , testProperty "closedness of implication" $ \x -> impliesExts (impliesExts x) == impliesExts x , testProperty "closedness of toExtensionList" $ \l x -> let es = toExtensionList l x in es == impliesExts es , testProperty "opposite extensions 1" $ \x -> [EnableExtension x, DisableExtension x] ~~ [DisableExtension x] , testProperty "opposite extensions 2" $ \x -> [DisableExtension x, EnableExtension x] ~~ [EnableExtension x] ] haskell-src-exts-1.14.0/Test/printFail.txt0000644000000000000000000000054612204617765016603 0ustar0000000000000000HexPrec.hs Uses hexadecimal notation to specify precedence of infix operator. We don't retain that info. RealGHC.lhs Literate haskell. SpecializeInstance.hs Prints SPECIALISE instead of SPECIALIZE. Unicode.hs Printing is not Unicode-aware. UnicodeSyntax.hs Printing is not Unicode-aware. QuasiQuoteOld.hs Exact printer always uses new quasi-quote syntax. haskell-src-exts-1.14.0/Test/examples/0000755000000000000000000000000012204617765015723 5ustar0000000000000000haskell-src-exts-1.14.0/Test/examples/THTypes.hs0000644000000000000000000000034412204617765017620 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} module THTypes where import Language.Haskell.TH x :: DecsQ x = [d| instance Show $(conT (mkName \"Int\")) |] unit x = [t| $x |] haskell-src-exts-1.14.0/Test/examples/BadStringLineBreak.hs0000644000000000000000000000026412204617765021713 0ustar0000000000000000module BadStringLineBreak where main = print $ "hello" ++ "world -- any random junk that goes here gets added onto the character count -- and the quote ends it with some garbage "haskell-src-exts-1.14.0/Test/examples/IndentedWhere.hs0000644000000000000000000000004712204617765021005 0ustar0000000000000000 f x = g where g :: Int g = 0haskell-src-exts-1.14.0/Test/examples/ArrowLayout.hs0000644000000000000000000000020212204617765020541 0ustar0000000000000000{-# LANGUAGE Arrows #-} module ArrowLayout where exp = proc () -> do rec let e = 1 + i i <- integral -< e returnA -< e haskell-src-exts-1.14.0/Test/examples/FixityTests.hs0000644000000000000000000000020312204617765020551 0ustar0000000000000000main = forM_ cmdReports $ \x -> do putStrLn $ "Writing report to " ++ x ++ " ..." writeReport x ideashaskell-src-exts-1.14.0/Test/examples/UnboxedTuples.hs0000644000000000000000000000017512204617765021063 0ustar0000000000000000{-# LANGUAGE UnboxedTuples #-} foo :: (a, b) -> (# b , a #) foo (a, b) = case (# b, a #) of (# b, a #) -> (# , #) b a haskell-src-exts-1.14.0/Test/examples/UnboxedSingleton.hs0000644000000000000000000000012012204617765021537 0ustar0000000000000000{-# LANGUAGE UnboxedTuples #-} -- See e.g. GHC.Prim.indexArray# foo a = (# a #) haskell-src-exts-1.14.0/Test/examples/ParallelListComp.hs0000644000000000000000000000014012204617765021461 0ustar0000000000000000{-# LANGUAGE ParallelListComp #-} f xs ys zs = [ (x,y,z) | x <- xs | y <- ys, y > 2 | z <- zs ]haskell-src-exts-1.14.0/Test/examples/RecordInfixSelector.hs0000644000000000000000000000013112204617765022167 0ustar0000000000000000data RecordWithInfixSelector = Cons { (<>) :: Int -> Int } idRecord = Cons { (<>) = id }haskell-src-exts-1.14.0/Test/examples/ParenFunBind.hs0000644000000000000000000000005412204617765020571 0ustar0000000000000000module ParenFunBind where (foo x) y = x + yhaskell-src-exts-1.14.0/Test/examples/ExtraEndBrace.hs0000644000000000000000000000006112204617765020723 0ustar0000000000000000module ExtraEndBrace where data A = B {c :: D}} haskell-src-exts-1.14.0/Test/examples/Attributes.hs0000644000000000000000000026646112204617765020424 0ustar0000000000000000{- | Module : Data.GraphViz.Attributes Description : Definition of the Graphviz attributes. Copyright : (c) Matthew Sackman, Ivan Lazar Miljenovic License : 3-Clause BSD-style Maintainer : Ivan.Miljenovic@gmail.com This module defines the various attributes that different parts of a Graphviz graph can have. These attributes are based on the documentation found at: For more information on usage, etc. please see that document. A summary of known current constraints\/limitations\/differences: * There might still be a few cases where quotes are still not escaped/parsed correctly; if you find such a situation, please let me know; however, you should be able to use 'String' values directly without having to worry about when quotes are required or extra escaping of quote characters as 'PrintDot' and 'ParseDot' instances for 'String' should take care of that for you. * Note that for an edge, in /Dot/ parlance if the edge goes from /A/ to /B/, then /A/ is the tail node and /B/ is the head node (since /A/ is at the tail end of the arrow). * ColorList and PointfList are defined as actual lists (but 'LayerList' is not). Note that for the Color 'Attribute' for node values, only a single Color is valid; edges are allowed multiple colors with one spline/arrow per color in the list (but you must have at least one 'Color' in the list). This might be changed in future. * Style is implemented as a list of 'StyleItem' values; note that empty lists are not allowed. * A lot of values have a possible value of @none@. These now have custom constructors. In fact, most constructors have been expanded upon to give an idea of what they represent rather than using generic terms. * @PointF@ and 'Point' have been combined, and feature support for pure 'Int'-based co-ordinates as well as 'Double' ones (i.e. no floating point-only points for Point). The optional '!' and third value for Point are not available. * 'Rect' uses two 'Point' values to denote the lower-left and top-right corners. * The two 'LabelLoc' attributes have been combined. * The defined 'LayerSep' is not used to parse 'LayerRange' or 'LayerList'; the default (@[' ', ':', '\t']@) is instead used. * @SplineType@ has been replaced with @['Spline']@. * Only polygon-based 'Shape's are available. * 'PortPos' only has the 'CompassPoint' option, not @PortName[:CompassPoint]@ (since record shapes aren't allowed, and parsing HTML-like labels could be problematic). * Not every 'Attribute' is fully documented/described. However, all those which have specific allowed values should be covered. * Deprecated 'Overlap' algorithms are not defined. * The global @Orientation@ attribute is not defined, as it is difficult to distinguish from the node-based 'Orientation' 'Attribute'; also, its behaviour is duplicated by 'Rotate'. -} module Data.GraphViz.Attributes ( -- * The actual /Dot/ attributes. Attribute(..) , Attributes -- ** Validity functions on @Attribute@ values. , usedByGraphs , usedBySubGraphs , usedByClusters , usedByNodes , usedByEdges -- * Value types for @Attribute@s. , EscString , URL(..) , ArrowType(..) , AspectType(..) , Rect(..) , ClusterMode(..) , DirType(..) , DEConstraints(..) , DPoint(..) , ModeType(..) , Model(..) , Label(..) , Point(..) , Overlap(..) , LayerRange(..) , LayerID(..) , LayerList(..) , OutputMode(..) , Pack(..) , PackMode(..) , Pos(..) , EdgeType(..) , PageDir(..) , Spline(..) , QuadType(..) , Root(..) , RankType(..) , RankDir(..) , Shape(..) , SmoothType(..) , StartType(..) , STStyle(..) , StyleItem(..) , StyleName(..) , PortPos(..) , CompassPoint(..) , ViewPort(..) , FocusType(..) , VerticalPlacement(..) , ScaleType(..) , Justification(..) , Ratios(..) , module Data.GraphViz.Attributes.Colors -- * Types representing the Dot grammar for @ArrowType@. , ArrowShape(..) , ArrowModifier(..) , ArrowFill(..) , ArrowSide(..) -- ** Default @ArrowType@ aliases. -- *** The 9 primitive @ArrowShape@s. , box , crow , diamond , dotArrow , inv , noArrow , normal , tee , vee -- *** 5 derived Arrows. , oDot , invDot , invODot , oBox , oDiamond -- *** 5 supported cases for backwards compatibility , eDiamond , openArr , halfOpen , emptyArr , invEmpty -- ** @ArrowModifier@ instances , noMods , openMod -- * Other exported functions\/values , defLayerSep , notLayerSep ) where import Data.GraphViz.Attributes.Colors import Data.GraphViz.Util import Data.GraphViz.Parsing import Data.GraphViz.Printing import Data.Char(toLower) import Data.Maybe(isJust) import Control.Arrow(first) import Control.Monad(liftM, liftM2) -- ----------------------------------------------------------------------------- {- | These attributes have been implemented in a /permissive/ manner: that is, rather than split them up based on which type of value they are allowed, they have all been included in the one data type, with functions to determine if they are indeed valid for what they're being applied to. To interpret the /Valid for/ listings: [@G@] Valid for Graphs. [@C@] Valid for Clusters. [@S@] Valid for Sub-Graphs (and also Clusters). [@N@] Valid for Nodes. [@E@] Valid for Edges. The /Default/ listings are those that the various Graphviz commands use if that 'Attribute' isn't specified (in cases where this is /none/, this is equivalent to a 'Nothing' value; that is, no value is used). The /Parsing Default/ listings represent what value is used (i.e. corresponds to 'True') when the 'Attribute' name is listed on its own in /Dot/ source code. -} data Attribute = Damping Double -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: neato only | K Double -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: sfdp, fdp only | URL URL -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only | ArrowHead ArrowType -- ^ /Valid for/: E; /Default/: @'normal'@ | ArrowSize Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@ | ArrowTail ArrowType -- ^ /Valid for/: E; /Default/: @'normal'@ | Aspect AspectType -- ^ /Valid for/: G; /Notes/: dot only | Bb Rect -- ^ /Valid for/: G; /Notes/: write only | BgColor Color -- ^ /Valid for/: GC; /Default/: X11Color 'Transparent' | Center Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True' | Charset String -- ^ /Valid for/: G; /Default/: @\"UTF-8\"@ | ClusterRank ClusterMode -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: dot only | ColorScheme ColorScheme -- ^ /Valid for/: ENCG; /Default/: @'X11'@ | Color [Color] -- ^ /Valid for/: ENC; /Default/: @X11Color 'Black'@ | Comment String -- ^ /Valid for/: ENG; /Default/: @\"\"@ | Compound Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only | Concentrate Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True' | Constraint Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: dot only | Decorate Bool -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True' | DefaultDist Double -- ^ /Valid for/: G; /Default/: @1+(avg. len)*sqrt(|V|)@; /Minimum/: @epsilon@; /Notes/: neato only | Dimen Int -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only | Dim Int -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only | Dir DirType -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected) | DirEdgeConstraints DEConstraints -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: neato only | Distortion Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@ | DPI Double -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym | EdgeURL URL -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only | EdgeTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only | EdgeTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only | Epsilon Double -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: neato only | ESep DPoint -- ^ /Valid for/: G; /Default/: @+3@; /Notes/: not dot | FillColor Color -- ^ /Valid for/: NC; /Default/: @X11Color 'LightGray'@ (nodes), @X11Color 'Black'@ (clusters) | FixedSize Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True' | FontColor Color -- ^ /Valid for/: ENGC; /Default/: @X11Color 'Black'@ | FontName String -- ^ /Valid for/: ENGC; /Default/: @\"Times-Roman\"@ | FontNames String -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only | FontPath String -- ^ /Valid for/: G; /Default/: system-dependent | FontSize Double -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@ | Group String -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: dot only | HeadURL URL -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only | HeadClip Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True' | HeadLabel Label -- ^ /Valid for/: E; /Default/: @\"\"@ | HeadPort PortPos -- ^ /Valid for/: E; /Default/: @'PP' 'CenterPoint'@ | HeadTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only | HeadTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only | Height Double -- ^ /Valid for/: N; /Default/: @0.5@; /Minimum/: @0.02@ | ID Label -- ^ /Valid for/: GNE; /Default/: @\"\"@; /Notes/: svg, postscript, map only | Image String -- ^ /Valid for/: N; /Default/: @\"\"@ | ImageScale ScaleType -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale' | LabelURL URL -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only | LabelAngle Double -- ^ /Valid for/: E; /Default/: @-25.0@; /Minimum/: @-180.0@ | LabelDistance Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@ | LabelFloat Bool -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True' | LabelFontColor Color -- ^ /Valid for/: E; /Default/: @X11Color 'Black'@ | LabelFontName String -- ^ /Valid for/: E; /Default/: @\"Times-Roman\"@ | LabelFontSize Double -- ^ /Valid for/: E; /Default/: @14.0@; /Minimum/: @1.0@ | LabelJust Justification -- ^ /Valid for/: GC; /Default/: @'JCenter'@ | LabelLoc VerticalPlacement -- ^ /Valid for/: GCN; /Default/: @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes) | LabelTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only | LabelTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only | Label Label -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise) | Landscape Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True' | LayerSep String -- ^ /Valid for/: G; /Default/: @\" :\t\"@ | Layers LayerList -- ^ /Valid for/: G; /Default/: @\"\"@ | Layer LayerRange -- ^ /Valid for/: EN; /Default/: @\"\"@ | Layout String -- ^ /Valid for/: G; /Default/: @\"\"@ | Len Double -- ^ /Valid for/: E; /Default/: @1.0@ (neato), @0.3@ (fdp); /Notes/: fdp, neato only | LevelsGap Double -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: neato only | Levels Int -- ^ /Valid for/: G; /Default/: @MAXINT@; /Minimum/: @0@; /Notes/: sfdp only | LHead String -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only | LPos Point -- ^ /Valid for/: EGC; /Notes/: write only | LTail String -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only | Margin DPoint -- ^ /Valid for/: NG; /Default/: device-dependent | MaxIter Int -- ^ /Valid for/: G; /Default/: @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp); /Notes/: fdp, neato only | MCLimit Double -- ^ /Valid for/: G; /Default/: @1.0@; /Notes/: dot only | MinDist Double -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: circo only | MinLen Int -- ^ /Valid for/: E; /Default/: @1@; /Minimum/: @0@; /Notes/: dot only | Model Model -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: neato only | Mode ModeType -- ^ /Valid for/: G; /Default/: @'Major'@; /Notes/: neato only | Mosek Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: neato only; requires the Mosek software | NodeSep Double -- ^ /Valid for/: G; /Default/: @0.25@; /Minimum/: @0.02@; /Notes/: dot only | NoJustify Bool -- ^ /Valid for/: GCNE; /Default/: @'False'@; /Parsing Default/: 'True' | Normalize Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: not dot | Nslimit1 Double -- ^ /Valid for/: G; /Notes/: dot only | Nslimit Double -- ^ /Valid for/: G; /Notes/: dot only | Ordering String -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: dot only | Orientation Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@ | OutputOrder OutputMode -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@ | OverlapScaling Double -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: prism only | Overlap Overlap -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not dot | PackMode PackMode -- ^ /Valid for/: G; /Default/: @'PackNode'@; /Notes/: not dot | Pack Pack -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'DoPack'; /Notes/: not dot | Pad DPoint -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points) | PageDir PageDir -- ^ /Valid for/: G; /Default/: @'BL'@ | Page Point -- ^ /Valid for/: G | PenColor Color -- ^ /Valid for/: C; /Default/: @X11Color 'Black'@ | PenWidth Double -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@ | Peripheries Int -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0 | Pin Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: fdp, neato only | Pos Pos -- ^ /Valid for/: EN | QuadTree QuadType -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: sfdp only | Quantum Double -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@ | RankDir RankDir -- ^ /Valid for/: G; /Default/: @'TB'@; /Notes/: dot only | RankSep Double -- ^ /Valid for/: G; /Default/: @0.5@ (dot), @1.0@ (twopi); /Minimum/: 0.02; /Notes/: twopi, dot only | Rank RankType -- ^ /Valid for/: S; /Notes/: dot only | Ratio Ratios -- ^ /Valid for/: G | Rects Rect -- ^ /Valid for/: N; /Notes/: write only | Regular Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True' | ReMinCross Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only | RepulsiveForce Double -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: sfdp only | Root Root -- ^ /Valid for/: GN; /Default/: @'NodeName' \"\"@ (graphs), @'NotCentral'@ (nodes); /Parsing Default/: 'IsCentral'; /Notes/: circo, twopi only | Rotate Int -- ^ /Valid for/: G; /Default/: @0@ | SameHead String -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only | SameTail String -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only | SamplePoints Int -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps) | SearchSize Int -- ^ /Valid for/: G; /Default/: @30@; /Notes/: dot only | Sep DPoint -- ^ /Valid for/: G; /Default/: @+4@; /Notes/: not dot | ShapeFile String -- ^ /Valid for/: N; /Default/: @\"\"@ | Shape Shape -- ^ /Valid for/: N; /Default/: @'Ellipse'@ | ShowBoxes Int -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: dot only | Sides Int -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@ | Size Point -- ^ /Valid for/: G | Skew Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@ | Smoothing SmoothType -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: sfdp only | SortV Int -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@ | Splines EdgeType -- ^ /Valid for/: G; /Parsing Default/: 'SplineEdges' | Start StartType -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: fdp, neato only | StyleSheet String -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only | Style [StyleItem] -- ^ /Valid for/: ENC | TailURL URL -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only | TailClip Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True' | TailLabel Label -- ^ /Valid for/: E; /Default/: @\"\"@ | TailPort PortPos -- ^ /Valid for/: E; /Default/: center | TailTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only | TailTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only | Target EscString -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, map only | Tooltip EscString -- ^ /Valid for/: NEC; /Default/: @\"\"@; /Notes/: svg, cmap only | TrueColor Bool -- ^ /Valid for/: G; /Parsing Default/: 'True'; /Notes/: bitmap output only | Vertices [Point] -- ^ /Valid for/: N; /Notes/: write only | ViewPort ViewPort -- ^ /Valid for/: G; /Default/: none | VoroMargin Double -- ^ /Valid for/: G; /Default/: @0.05@; /Minimum/: @0.0@; /Notes/: not dot | Weight Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0@ (dot), @1@ (neato,fdp,sfdp) | Width Double -- ^ /Valid for/: N; /Default/: @0.75@; /Minimum/: @0.01@ | Z Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-MAXFLOAT@, @-1000@ deriving (Eq, Ord, Show, Read) type Attributes = [Attribute] instance PrintDot Attribute where unqtDot (Damping v) = printField "Damping" v unqtDot (K v) = printField "K" v unqtDot (URL v) = printField "URL" v unqtDot (ArrowHead v) = printField "arrowhead" v unqtDot (ArrowSize v) = printField "arrowsize" v unqtDot (ArrowTail v) = printField "arrowtail" v unqtDot (Aspect v) = printField "aspect" v unqtDot (Bb v) = printField "bb" v unqtDot (BgColor v) = printField "bgcolor" v unqtDot (Center v) = printField "center" v unqtDot (Charset v) = printField "charset" v unqtDot (ClusterRank v) = printField "clusterrank" v unqtDot (ColorScheme v) = printField "colorscheme" v unqtDot (Color v) = printField "color" v unqtDot (Comment v) = printField "comment" v unqtDot (Compound v) = printField "compound" v unqtDot (Concentrate v) = printField "concentrate" v unqtDot (Constraint v) = printField "constraint" v unqtDot (Decorate v) = printField "decorate" v unqtDot (DefaultDist v) = printField "defaultdist" v unqtDot (Dimen v) = printField "dimen" v unqtDot (Dim v) = printField "dim" v unqtDot (Dir v) = printField "dir" v unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v unqtDot (Distortion v) = printField "distortion" v unqtDot (DPI v) = printField "dpi" v unqtDot (EdgeURL v) = printField "edgeURL" v unqtDot (EdgeTarget v) = printField "edgetarget" v unqtDot (EdgeTooltip v) = printField "edgetooltip" v unqtDot (Epsilon v) = printField "epsilon" v unqtDot (ESep v) = printField "esep" v unqtDot (FillColor v) = printField "fillcolor" v unqtDot (FixedSize v) = printField "fixedsize" v unqtDot (FontColor v) = printField "fontcolor" v unqtDot (FontName v) = printField "fontname" v unqtDot (FontNames v) = printField "fontnames" v unqtDot (FontPath v) = printField "fontpath" v unqtDot (FontSize v) = printField "fontsize" v unqtDot (Group v) = printField "group" v unqtDot (HeadURL v) = printField "headURL" v unqtDot (HeadClip v) = printField "headclip" v unqtDot (HeadLabel v) = printField "headlabel" v unqtDot (HeadPort v) = printField "headport" v unqtDot (HeadTarget v) = printField "headtarget" v unqtDot (HeadTooltip v) = printField "headtooltip" v unqtDot (Height v) = printField "height" v unqtDot (ID v) = printField "id" v unqtDot (Image v) = printField "image" v unqtDot (ImageScale v) = printField "imagescale" v unqtDot (LabelURL v) = printField "labelURL" v unqtDot (LabelAngle v) = printField "labelangle" v unqtDot (LabelDistance v) = printField "labeldistance" v unqtDot (LabelFloat v) = printField "labelfloat" v unqtDot (LabelFontColor v) = printField "labelfontcolor" v unqtDot (LabelFontName v) = printField "labelfontname" v unqtDot (LabelFontSize v) = printField "labelfontsize" v unqtDot (LabelJust v) = printField "labeljust" v unqtDot (LabelLoc v) = printField "labelloc" v unqtDot (LabelTarget v) = printField "labeltarget" v unqtDot (LabelTooltip v) = printField "labeltooltip" v unqtDot (Label v) = printField "label" v unqtDot (Landscape v) = printField "landscape" v unqtDot (LayerSep v) = printField "layersep" v unqtDot (Layers v) = printField "layers" v unqtDot (Layer v) = printField "layer" v unqtDot (Layout v) = printField "layout" v unqtDot (Len v) = printField "len" v unqtDot (LevelsGap v) = printField "levelsgap" v unqtDot (Levels v) = printField "levels" v unqtDot (LHead v) = printField "lhead" v unqtDot (LPos v) = printField "lp" v unqtDot (LTail v) = printField "ltail" v unqtDot (Margin v) = printField "margin" v unqtDot (MaxIter v) = printField "maxiter" v unqtDot (MCLimit v) = printField "mclimit" v unqtDot (MinDist v) = printField "mindist" v unqtDot (MinLen v) = printField "minlen" v unqtDot (Model v) = printField "model" v unqtDot (Mode v) = printField "mode" v unqtDot (Mosek v) = printField "mosek" v unqtDot (NodeSep v) = printField "nodesep" v unqtDot (NoJustify v) = printField "nojustify" v unqtDot (Normalize v) = printField "normalize" v unqtDot (Nslimit1 v) = printField "nslimit1" v unqtDot (Nslimit v) = printField "nslimit" v unqtDot (Ordering v) = printField "ordering" v unqtDot (Orientation v) = printField "orientation" v unqtDot (OutputOrder v) = printField "outputorder" v unqtDot (OverlapScaling v) = printField "overlap_scaling" v unqtDot (Overlap v) = printField "overlap" v unqtDot (PackMode v) = printField "packmode" v unqtDot (Pack v) = printField "pack" v unqtDot (Pad v) = printField "pad" v unqtDot (PageDir v) = printField "pagedir" v unqtDot (Page v) = printField "page" v unqtDot (PenColor v) = printField "pencolor" v unqtDot (PenWidth v) = printField "penwidth" v unqtDot (Peripheries v) = printField "peripheries" v unqtDot (Pin v) = printField "pin" v unqtDot (Pos v) = printField "pos" v unqtDot (QuadTree v) = printField "quadtree" v unqtDot (Quantum v) = printField "quantum" v unqtDot (RankDir v) = printField "rankdir" v unqtDot (RankSep v) = printField "ranksep" v unqtDot (Rank v) = printField "rank" v unqtDot (Ratio v) = printField "ratio" v unqtDot (Rects v) = printField "rects" v unqtDot (Regular v) = printField "regular" v unqtDot (ReMinCross v) = printField "remincross" v unqtDot (RepulsiveForce v) = printField "repulsiveforce" v unqtDot (Root v) = printField "root" v unqtDot (Rotate v) = printField "rotate" v unqtDot (SameHead v) = printField "samehead" v unqtDot (SameTail v) = printField "sametail" v unqtDot (SamplePoints v) = printField "samplepoints" v unqtDot (SearchSize v) = printField "searchsize" v unqtDot (Sep v) = printField "sep" v unqtDot (ShapeFile v) = printField "shapefile" v unqtDot (Shape v) = printField "shape" v unqtDot (ShowBoxes v) = printField "showboxes" v unqtDot (Sides v) = printField "sides" v unqtDot (Size v) = printField "size" v unqtDot (Skew v) = printField "skew" v unqtDot (Smoothing v) = printField "smoothing" v unqtDot (SortV v) = printField "sortv" v unqtDot (Splines v) = printField "splines" v unqtDot (Start v) = printField "start" v unqtDot (StyleSheet v) = printField "stylesheet" v unqtDot (Style v) = printField "style" v unqtDot (TailURL v) = printField "tailURL" v unqtDot (TailClip v) = printField "tailclip" v unqtDot (TailLabel v) = printField "taillabel" v unqtDot (TailPort v) = printField "tailport" v unqtDot (TailTarget v) = printField "tailtarget" v unqtDot (TailTooltip v) = printField "tailtooltip" v unqtDot (Target v) = printField "target" v unqtDot (Tooltip v) = printField "tooltip" v unqtDot (TrueColor v) = printField "truecolor" v unqtDot (Vertices v) = printField "vertices" v unqtDot (ViewPort v) = printField "viewport" v unqtDot (VoroMargin v) = printField "voro_margin" v unqtDot (Weight v) = printField "weight" v unqtDot (Width v) = printField "width" v unqtDot (Z v) = printField "z" v listToDot = unqtListToDot instance ParseDot Attribute where parseUnqt = oneOf [ liftM Damping $ parseField "Damping" , liftM K $ parseField "K" , liftM URL $ parseFields ["URL", "href"] , liftM ArrowHead $ parseField "arrowhead" , liftM ArrowSize $ parseField "arrowsize" , liftM ArrowTail $ parseField "arrowtail" , liftM Aspect $ parseField "aspect" , liftM Bb $ parseField "bb" , liftM BgColor $ parseField "bgcolor" , liftM Center $ parseFieldBool "center" , liftM Charset $ parseField "charset" , liftM ClusterRank $ parseField "clusterrank" , liftM ColorScheme $ parseField "colorscheme" , liftM Color $ parseField "color" , liftM Comment $ parseField "comment" , liftM Compound $ parseFieldBool "compound" , liftM Concentrate $ parseFieldBool "concentrate" , liftM Constraint $ parseFieldBool "constraint" , liftM Decorate $ parseFieldBool "decorate" , liftM DefaultDist $ parseField "defaultdist" , liftM Dimen $ parseField "dimen" , liftM Dim $ parseField "dim" , liftM Dir $ parseField "dir" , liftM DirEdgeConstraints $ parseFieldDef EdgeConstraints "diredgeconstraints" , liftM Distortion $ parseField "distortion" , liftM DPI $ parseFields ["dpi", "resolution"] , liftM EdgeURL $ parseFields ["edgeURL", "edgehref"] , liftM EdgeTarget $ parseField "edgetarget" , liftM EdgeTooltip $ parseField "edgetooltip" , liftM Epsilon $ parseField "epsilon" , liftM ESep $ parseField "esep" , liftM FillColor $ parseField "fillcolor" , liftM FixedSize $ parseFieldBool "fixedsize" , liftM FontColor $ parseField "fontcolor" , liftM FontName $ parseField "fontname" , liftM FontNames $ parseField "fontnames" , liftM FontPath $ parseField "fontpath" , liftM FontSize $ parseField "fontsize" , liftM Group $ parseField "group" , liftM HeadURL $ parseFields ["headURL", "headhref"] , liftM HeadClip $ parseFieldBool "headclip" , liftM HeadLabel $ parseField "headlabel" , liftM HeadPort $ parseField "headport" , liftM HeadTarget $ parseField "headtarget" , liftM HeadTooltip $ parseField "headtooltip" , liftM Height $ parseField "height" , liftM ID $ parseField "id" , liftM Image $ parseField "image" , liftM ImageScale $ parseFieldDef UniformScale "imagescale" , liftM LabelURL $ parseFields ["labelURL", "labelhref"] , liftM LabelAngle $ parseField "labelangle" , liftM LabelDistance $ parseField "labeldistance" , liftM LabelFloat $ parseFieldBool "labelfloat" , liftM LabelFontColor $ parseField "labelfontcolor" , liftM LabelFontName $ parseField "labelfontname" , liftM LabelFontSize $ parseField "labelfontsize" , liftM LabelJust $ parseField "labeljust" , liftM LabelLoc $ parseField "labelloc" , liftM LabelTarget $ parseField "labeltarget" , liftM LabelTooltip $ parseField "labeltooltip" , liftM Label $ parseField "label" , liftM Landscape $ parseFieldBool "landscape" , liftM LayerSep $ parseField "layersep" , liftM Layers $ parseField "layers" , liftM Layer $ parseField "layer" , liftM Layout $ parseField "layout" , liftM Len $ parseField "len" , liftM LevelsGap $ parseField "levelsgap" , liftM Levels $ parseField "levels" , liftM LHead $ parseField "lhead" , liftM LPos $ parseField "lp" , liftM LTail $ parseField "ltail" , liftM Margin $ parseField "margin" , liftM MaxIter $ parseField "maxiter" , liftM MCLimit $ parseField "mclimit" , liftM MinDist $ parseField "mindist" , liftM MinLen $ parseField "minlen" , liftM Model $ parseField "model" , liftM Mode $ parseField "mode" , liftM Mosek $ parseFieldBool "mosek" , liftM NodeSep $ parseField "nodesep" , liftM NoJustify $ parseFieldBool "nojustify" , liftM Normalize $ parseFieldBool "normalize" , liftM Nslimit1 $ parseField "nslimit1" , liftM Nslimit $ parseField "nslimit" , liftM Ordering $ parseField "ordering" , liftM Orientation $ parseField "orientation" , liftM OutputOrder $ parseField "outputorder" , liftM OverlapScaling $ parseField "overlap_scaling" , liftM Overlap $ parseFieldDef KeepOverlaps "overlap" , liftM PackMode $ parseField "packmode" , liftM Pack $ parseFieldDef DoPack "pack" , liftM Pad $ parseField "pad" , liftM PageDir $ parseField "pagedir" , liftM Page $ parseField "page" , liftM PenColor $ parseField "pencolor" , liftM PenWidth $ parseField "penwidth" , liftM Peripheries $ parseField "peripheries" , liftM Pin $ parseFieldBool "pin" , liftM Pos $ parseField "pos" , liftM QuadTree $ parseFieldDef NormalQT "quadtree" , liftM Quantum $ parseField "quantum" , liftM RankDir $ parseField "rankdir" , liftM RankSep $ parseField "ranksep" , liftM Rank $ parseField "rank" , liftM Ratio $ parseField "ratio" , liftM Rects $ parseField "rects" , liftM Regular $ parseFieldBool "regular" , liftM ReMinCross $ parseFieldBool "remincross" , liftM RepulsiveForce $ parseField "repulsiveforce" , liftM Root $ parseFieldDef IsCentral "root" , liftM Rotate $ parseField "rotate" , liftM SameHead $ parseField "samehead" , liftM SameTail $ parseField "sametail" , liftM SamplePoints $ parseField "samplepoints" , liftM SearchSize $ parseField "searchsize" , liftM Sep $ parseField "sep" , liftM ShapeFile $ parseField "shapefile" , liftM Shape $ parseField "shape" , liftM ShowBoxes $ parseField "showboxes" , liftM Sides $ parseField "sides" , liftM Size $ parseField "size" , liftM Skew $ parseField "skew" , liftM Smoothing $ parseField "smoothing" , liftM SortV $ parseField "sortv" , liftM Splines $ parseFieldDef SplineEdges "splines" , liftM Start $ parseField "start" , liftM StyleSheet $ parseField "stylesheet" , liftM Style $ parseField "style" , liftM TailURL $ parseFields ["tailURL", "tailhref"] , liftM TailClip $ parseFieldBool "tailclip" , liftM TailLabel $ parseField "taillabel" , liftM TailPort $ parseField "tailport" , liftM TailTarget $ parseField "tailtarget" , liftM TailTooltip $ parseField "tailtooltip" , liftM Target $ parseField "target" , liftM Tooltip $ parseField "tooltip" , liftM TrueColor $ parseFieldBool "truecolor" , liftM Vertices $ parseField "vertices" , liftM ViewPort $ parseField "viewport" , liftM VoroMargin $ parseField "voro_margin" , liftM Weight $ parseField "weight" , liftM Width $ parseField "width" , liftM Z $ parseField "z" ] parse = parseUnqt parseList = parseUnqtList -- | Determine if this Attribute is valid for use with Graphs. usedByGraphs :: Attribute -> Bool usedByGraphs Damping{} = True usedByGraphs K{} = True usedByGraphs URL{} = True usedByGraphs Aspect{} = True usedByGraphs Bb{} = True usedByGraphs BgColor{} = True usedByGraphs Center{} = True usedByGraphs Charset{} = True usedByGraphs ClusterRank{} = True usedByGraphs ColorScheme{} = True usedByGraphs Comment{} = True usedByGraphs Compound{} = True usedByGraphs Concentrate{} = True usedByGraphs DefaultDist{} = True usedByGraphs Dimen{} = True usedByGraphs Dim{} = True usedByGraphs DirEdgeConstraints{} = True usedByGraphs DPI{} = True usedByGraphs Epsilon{} = True usedByGraphs ESep{} = True usedByGraphs FontColor{} = True usedByGraphs FontName{} = True usedByGraphs FontNames{} = True usedByGraphs FontPath{} = True usedByGraphs FontSize{} = True usedByGraphs ID{} = True usedByGraphs LabelJust{} = True usedByGraphs LabelLoc{} = True usedByGraphs Label{} = True usedByGraphs Landscape{} = True usedByGraphs LayerSep{} = True usedByGraphs Layers{} = True usedByGraphs Layout{} = True usedByGraphs LevelsGap{} = True usedByGraphs Levels{} = True usedByGraphs LPos{} = True usedByGraphs Margin{} = True usedByGraphs MaxIter{} = True usedByGraphs MCLimit{} = True usedByGraphs MinDist{} = True usedByGraphs Model{} = True usedByGraphs Mode{} = True usedByGraphs Mosek{} = True usedByGraphs NodeSep{} = True usedByGraphs NoJustify{} = True usedByGraphs Normalize{} = True usedByGraphs Nslimit1{} = True usedByGraphs Nslimit{} = True usedByGraphs Ordering{} = True usedByGraphs OutputOrder{} = True usedByGraphs OverlapScaling{} = True usedByGraphs Overlap{} = True usedByGraphs PackMode{} = True usedByGraphs Pack{} = True usedByGraphs Pad{} = True usedByGraphs PageDir{} = True usedByGraphs Page{} = True usedByGraphs QuadTree{} = True usedByGraphs Quantum{} = True usedByGraphs RankDir{} = True usedByGraphs RankSep{} = True usedByGraphs Ratio{} = True usedByGraphs ReMinCross{} = True usedByGraphs RepulsiveForce{} = True usedByGraphs Root{} = True usedByGraphs Rotate{} = True usedByGraphs SearchSize{} = True usedByGraphs Sep{} = True usedByGraphs ShowBoxes{} = True usedByGraphs Size{} = True usedByGraphs Smoothing{} = True usedByGraphs SortV{} = True usedByGraphs Splines{} = True usedByGraphs Start{} = True usedByGraphs StyleSheet{} = True usedByGraphs Target{} = True usedByGraphs TrueColor{} = True usedByGraphs ViewPort{} = True usedByGraphs VoroMargin{} = True usedByGraphs _ = False -- | Determine if this Attribute is valid for use with Clusters. usedByClusters :: Attribute -> Bool usedByClusters K{} = True usedByClusters URL{} = True usedByClusters BgColor{} = True usedByClusters ColorScheme{} = True usedByClusters Color{} = True usedByClusters FillColor{} = True usedByClusters FontColor{} = True usedByClusters FontName{} = True usedByClusters FontSize{} = True usedByClusters LabelJust{} = True usedByClusters LabelLoc{} = True usedByClusters Label{} = True usedByClusters LPos{} = True usedByClusters NoJustify{} = True usedByClusters PenColor{} = True usedByClusters PenWidth{} = True usedByClusters Peripheries{} = True usedByClusters Rank{} = True usedByClusters SortV{} = True usedByClusters Style{} = True usedByClusters Target{} = True usedByClusters Tooltip{} = True usedByClusters _ = False -- | Determine if this Attribute is valid for use with SubGraphs. usedBySubGraphs :: Attribute -> Bool usedBySubGraphs Rank{} = True usedBySubGraphs _ = False -- | Determine if this Attribute is valid for use with Nodes. usedByNodes :: Attribute -> Bool usedByNodes URL{} = True usedByNodes ColorScheme{} = True usedByNodes Color{} = True usedByNodes Comment{} = True usedByNodes Distortion{} = True usedByNodes FillColor{} = True usedByNodes FixedSize{} = True usedByNodes FontColor{} = True usedByNodes FontName{} = True usedByNodes FontSize{} = True usedByNodes Group{} = True usedByNodes Height{} = True usedByNodes ID{} = True usedByNodes Image{} = True usedByNodes ImageScale{} = True usedByNodes LabelLoc{} = True usedByNodes Label{} = True usedByNodes Layer{} = True usedByNodes Margin{} = True usedByNodes NoJustify{} = True usedByNodes Orientation{} = True usedByNodes PenWidth{} = True usedByNodes Peripheries{} = True usedByNodes Pin{} = True usedByNodes Pos{} = True usedByNodes Rects{} = True usedByNodes Regular{} = True usedByNodes Root{} = True usedByNodes SamplePoints{} = True usedByNodes ShapeFile{} = True usedByNodes Shape{} = True usedByNodes ShowBoxes{} = True usedByNodes Sides{} = True usedByNodes Skew{} = True usedByNodes SortV{} = True usedByNodes Style{} = True usedByNodes Target{} = True usedByNodes Tooltip{} = True usedByNodes Vertices{} = True usedByNodes Width{} = True usedByNodes Z{} = True usedByNodes _ = False -- | Determine if this Attribute is valid for use with Edges. usedByEdges :: Attribute -> Bool usedByEdges URL{} = True usedByEdges ArrowHead{} = True usedByEdges ArrowSize{} = True usedByEdges ArrowTail{} = True usedByEdges ColorScheme{} = True usedByEdges Color{} = True usedByEdges Comment{} = True usedByEdges Constraint{} = True usedByEdges Decorate{} = True usedByEdges Dir{} = True usedByEdges EdgeURL{} = True usedByEdges EdgeTarget{} = True usedByEdges EdgeTooltip{} = True usedByEdges FontColor{} = True usedByEdges FontName{} = True usedByEdges FontSize{} = True usedByEdges HeadURL{} = True usedByEdges HeadClip{} = True usedByEdges HeadLabel{} = True usedByEdges HeadPort{} = True usedByEdges HeadTarget{} = True usedByEdges HeadTooltip{} = True usedByEdges ID{} = True usedByEdges LabelURL{} = True usedByEdges LabelAngle{} = True usedByEdges LabelDistance{} = True usedByEdges LabelFloat{} = True usedByEdges LabelFontColor{} = True usedByEdges LabelFontName{} = True usedByEdges LabelFontSize{} = True usedByEdges LabelTarget{} = True usedByEdges LabelTooltip{} = True usedByEdges Label{} = True usedByEdges Layer{} = True usedByEdges Len{} = True usedByEdges LHead{} = True usedByEdges LPos{} = True usedByEdges LTail{} = True usedByEdges MinLen{} = True usedByEdges NoJustify{} = True usedByEdges PenWidth{} = True usedByEdges Pos{} = True usedByEdges SameHead{} = True usedByEdges SameTail{} = True usedByEdges ShowBoxes{} = True usedByEdges Style{} = True usedByEdges TailURL{} = True usedByEdges TailClip{} = True usedByEdges TailLabel{} = True usedByEdges TailPort{} = True usedByEdges TailTarget{} = True usedByEdges TailTooltip{} = True usedByEdges Target{} = True usedByEdges Tooltip{} = True usedByEdges Weight{} = True usedByEdges _ = False {- Delete to here -} -- ----------------------------------------------------------------------------- {- | Some 'Attribute's (mainly label-like ones) take a 'String' argument that allows for extra escape codes. This library doesn't do any extra checks or special parsing for these escape codes, but usage of 'EscString' rather than 'String' indicates that the Graphviz tools will recognise these extra escape codes for these 'Attribute's. The extra escape codes include (note that these are all 'String's): [@\\N@] Replace with the name of the node (for Node 'Attribute's). [@\\G@] Replace with the name of the graph (for Node 'Attribute's) or the name of the graph or cluster, whichever is applicable (for Graph, Cluster and Edge 'Attribute's). [@\\E@] Replace with the name of the edge, formed by the two adjoining nodes and the edge type (for Edge 'Attribute's). [@\\T@] Replace with the name of the tail node (for Edge 'Attribute's). [@\\H@] Replace with the name of the head node (for Edge 'Attribute's). [@\\L@] Replace with the object's label (for all 'Attribute's). Also, if the 'Attribute' in question is 'Label', 'HeadLabel' or 'TailLabel', then @\\n@, @\\l@ and @\\r@ split the label into lines centered, left-justified and right-justified respectively. -} type EscString = String -- ----------------------------------------------------------------------------- -- | No checks are placed on the content of a 'URL' value; however, -- you should ensure that it does not contain any \'@>@\' or \'@<@\' -- characters; Graphviz might care about escaping other characters -- properly, but for the purposes of this library the presence of -- these characters will make it harder to parse URLs. newtype URL = UStr { urlString :: EscString } deriving (Eq, Ord, Show, Read) instance PrintDot URL where unqtDot = wrap (char '<') (char '>') -- Explicitly use text here... no quotes! . text . urlString instance ParseDot URL where parseUnqt = liftM UStr $ bracket (character open) (character close) (many1 $ satisfy ((/=) close)) where open = '<' close = '>' -- No quotes parse = parseUnqt -- ----------------------------------------------------------------------------- -- | /Dot/ has a basic grammar of arrow shapes which allows usage of -- up to 1,544,761 different shapes from 9 different basic -- 'ArrowShape's. Note that whilst an explicit list is used in the -- definition of 'ArrowType', there must be at least one tuple and a -- maximum of 4 (since that is what is required by Dot). For more -- information, see: -- -- The 19 basic arrows shown on the overall attributes page have -- been defined below as a convenience. Parsing of the 5 -- backward-compatible special cases is also supported. newtype ArrowType = AType [(ArrowModifier, ArrowShape)] deriving (Eq, Ord, Show, Read) box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee :: ArrowType oDot, invDot, invODot, oBox, oDiamond :: ArrowType eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType normal = AType [(noMods, Normal)] inv = AType [(noMods, Inv)] dotArrow = AType [(noMods, DotArrow)] invDot = AType [ (noMods, Inv) , (noMods, DotArrow)] oDot = AType [(ArrMod OpenArrow BothSides, DotArrow)] invODot = AType [ (noMods, Inv) , (openMod, DotArrow)] noArrow = AType [(noMods, NoArrow)] tee = AType [(noMods, Tee)] emptyArr = AType [(openMod, Normal)] invEmpty = AType [ (noMods, Inv) , (openMod, Normal)] diamond = AType [(noMods, Diamond)] oDiamond = AType [(openMod, Diamond)] eDiamond = oDiamond crow = AType [(noMods, Crow)] box = AType [(noMods, Box)] oBox = AType [(openMod, Box)] openArr = vee halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)] vee = AType [(noMods, Vee)] instance PrintDot ArrowType where unqtDot (AType mas) = hcat $ map appMod mas where appMod (m, a) = unqtDot m <> unqtDot a instance ParseDot ArrowType where parseUnqt = do mas <- many1 $ do m <- parseUnqt a <- parseUnqt return (m,a) return $ AType mas `onFail` specialArrowParse specialArrowParse :: Parse ArrowType specialArrowParse = oneOf [ stringRep eDiamond "ediamond" , stringRep openArr "open" , stringRep halfOpen "halfopen" , stringRep emptyArr "empty" , stringRep invEmpty "invempty" ] data ArrowShape = Box | Crow | Diamond | DotArrow | Inv | NoArrow | Normal | Tee | Vee deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot ArrowShape where unqtDot Box = unqtDot "box" unqtDot Crow = unqtDot "crow" unqtDot Diamond = unqtDot "diamond" unqtDot DotArrow = unqtDot "dot" unqtDot Inv = unqtDot "inv" unqtDot NoArrow = unqtDot "none" unqtDot Normal = unqtDot "normal" unqtDot Tee = unqtDot "tee" unqtDot Vee = unqtDot "vee" instance ParseDot ArrowShape where parseUnqt = oneOf [ stringRep Box "box" , stringRep Crow "crow" , stringRep Diamond "diamond" , stringRep DotArrow "dot" , stringRep Inv "inv" , stringRep NoArrow "none" , stringRep Normal "normal" , stringRep Tee "tee" , stringRep Vee "vee" ] -- | What modifications to apply to an 'ArrowShape'. data ArrowModifier = ArrMod { arrowFill :: ArrowFill , arrowSide :: ArrowSide } deriving (Eq, Ord, Show, Read) -- | Apply no modifications to an 'ArrowShape'. noMods :: ArrowModifier noMods = ArrMod FilledArrow BothSides -- | 'OpenArrow' and 'BothSides' openMod :: ArrowModifier openMod = ArrMod OpenArrow BothSides instance PrintDot ArrowModifier where unqtDot (ArrMod f s) = unqtDot f <> unqtDot s instance ParseDot ArrowModifier where parseUnqt = do f <- parseUnqt s <- parseUnqt return $ ArrMod f s data ArrowFill = OpenArrow | FilledArrow deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot ArrowFill where unqtDot OpenArrow = char 'o' unqtDot FilledArrow = empty instance ParseDot ArrowFill where parseUnqt = liftM (bool FilledArrow OpenArrow . isJust) $ optional (character 'o') -- Not used individually parse = parseUnqt -- | Represents which side (when looking towards the node the arrow is -- pointing to) is drawn. data ArrowSide = LeftSide | RightSide | BothSides deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot ArrowSide where unqtDot LeftSide = char 'l' unqtDot RightSide = char 'r' unqtDot BothSides = empty instance ParseDot ArrowSide where parseUnqt = liftM getSideType $ optional (oneOf $ map character ['l', 'r']) where getSideType = maybe BothSides (bool RightSide LeftSide . (==) 'l') -- Not used individually parse = parseUnqt -- ----------------------------------------------------------------------------- data AspectType = RatioOnly Double | RatioPassCount Double Int deriving (Eq, Ord, Show, Read) instance PrintDot AspectType where unqtDot (RatioOnly r) = unqtDot r unqtDot (RatioPassCount r p) = commaDel r p toDot at@RatioOnly{} = unqtDot at toDot at@RatioPassCount{} = doubleQuotes $ unqtDot at instance ParseDot AspectType where parseUnqt = liftM (uncurry RatioPassCount) commaSepUnqt `onFail` liftM RatioOnly parseUnqt parse = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt) `onFail` liftM RatioOnly parse -- ----------------------------------------------------------------------------- data Rect = Rect Point Point deriving (Eq, Ord, Show, Read) instance PrintDot Rect where unqtDot (Rect p1 p2) = commaDel p1 p2 toDot = doubleQuotes . unqtDot instance ParseDot Rect where parseUnqt = liftM (uncurry Rect) commaSepUnqt parse = quotedParse parseUnqt -- ----------------------------------------------------------------------------- data ClusterMode = Local | Global | NoCluster deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot ClusterMode where unqtDot Local = unqtDot "local" unqtDot Global = unqtDot "global" unqtDot NoCluster = unqtDot "none" instance ParseDot ClusterMode where parseUnqt = oneOf [ stringRep Local "local" , stringRep Global "global" , stringRep NoCluster "none" ] -- ----------------------------------------------------------------------------- data DirType = Forward | Back | Both | NoDir deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot DirType where unqtDot Forward = unqtDot "forward" unqtDot Back = unqtDot "back" unqtDot Both = unqtDot "both" unqtDot NoDir = unqtDot "none" instance ParseDot DirType where parseUnqt = oneOf [ stringRep Forward "forward" , stringRep Back "back" , stringRep Both "both" , stringRep NoDir "none" ] -- ----------------------------------------------------------------------------- -- | Only when @mode == 'IpSep'@. data DEConstraints = EdgeConstraints | NoConstraints | HierConstraints deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot DEConstraints where unqtDot EdgeConstraints = unqtDot True unqtDot NoConstraints = unqtDot False unqtDot HierConstraints = text "hier" instance ParseDot DEConstraints where parseUnqt = liftM (bool NoConstraints EdgeConstraints) parse `onFail` stringRep HierConstraints "hier" -- ----------------------------------------------------------------------------- -- | Either a 'Double' or a 'Point'. data DPoint = DVal Double | PVal Point deriving (Eq, Ord, Show, Read) instance PrintDot DPoint where unqtDot (DVal d) = unqtDot d unqtDot (PVal p) = unqtDot p toDot (DVal d) = toDot d toDot (PVal p) = toDot p instance ParseDot DPoint where parseUnqt = liftM PVal parseUnqt `onFail` liftM DVal parseUnqt parse = liftM PVal parse `onFail` liftM DVal parse -- ----------------------------------------------------------------------------- data ModeType = Major | KK | Hier | IpSep deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot ModeType where unqtDot Major = text "major" unqtDot KK = text "KK" unqtDot Hier = text "hier" unqtDot IpSep = text "ipsep" instance ParseDot ModeType where parseUnqt = oneOf [ stringRep Major "major" , stringRep KK "KK" , stringRep Hier "hier" , stringRep IpSep "ipsep" ] -- ----------------------------------------------------------------------------- data Model = ShortPath | SubSet | Circuit deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot Model where unqtDot ShortPath = text "shortpath" unqtDot SubSet = text "subset" unqtDot Circuit = text "circuit" instance ParseDot Model where parseUnqt = oneOf [ stringRep ShortPath "shortpath" , stringRep SubSet "subset" , stringRep Circuit "circuit" ] -- ----------------------------------------------------------------------------- data Label = StrLabel EscString | URLLabel URL deriving (Eq, Ord, Show, Read) instance PrintDot Label where unqtDot (StrLabel s) = unqtDot s unqtDot (URLLabel u) = unqtDot u toDot (StrLabel s) = toDot s toDot (URLLabel u) = toDot u instance ParseDot Label where parseUnqt = liftM StrLabel parseUnqt `onFail` liftM URLLabel parseUnqt parse = liftM StrLabel parse `onFail` liftM URLLabel parse -- ----------------------------------------------------------------------------- data Point = Point Int Int | PointD Double Double deriving (Eq, Ord, Show, Read) instance PrintDot Point where unqtDot (Point x y) = commaDel x y unqtDot (PointD x y) = commaDel x y toDot = doubleQuotes . unqtDot unqtListToDot = hsep . map unqtDot listToDot = doubleQuotes . unqtListToDot instance ParseDot Point where -- Need to take into account the situation where first value is an -- integer, second a double: if Point parsing first, then it won't -- parse the second number properly; but if PointD first then it -- will treat Int/Int as Double/Double. parseUnqt = intDblPoint `onFail` liftM (uncurry Point) commaSepUnqt `onFail` liftM (uncurry PointD) commaSepUnqt where intDblPoint = liftM (uncurry PointD . first fI) $ commaSep' parseUnqt parseStrictFloat fI :: Int -> Double fI = fromIntegral parse = quotedParse parseUnqt parseUnqtList = sepBy1 parseUnqt whitespace -- ----------------------------------------------------------------------------- data Overlap = KeepOverlaps | RemoveOverlaps | ScaleOverlaps | ScaleXYOverlaps | PrismOverlap (Maybe Int) -- ^ Only when sfdp is available, 'Int' is non-negative | CompressOverlap | VpscOverlap | IpsepOverlap -- ^ Only when @mode == 'IpSep'@ deriving (Eq, Ord, Show, Read) instance PrintDot Overlap where unqtDot KeepOverlaps = unqtDot True unqtDot RemoveOverlaps = unqtDot False unqtDot ScaleOverlaps = text "scale" unqtDot ScaleXYOverlaps = text "scalexy" unqtDot (PrismOverlap i) = maybe id (flip (<>) . unqtDot) i $ text "prism" unqtDot CompressOverlap = text "compress" unqtDot VpscOverlap = text "vpsc" unqtDot IpsepOverlap = text "ipsep" instance ParseDot Overlap where parseUnqt = oneOf [ stringRep KeepOverlaps "true" , stringRep RemoveOverlaps "false" , stringRep ScaleXYOverlaps "scalexy" , stringRep ScaleOverlaps "scale" , string "prism" >> liftM PrismOverlap (optional parse) , stringRep CompressOverlap "compress" , stringRep VpscOverlap "vpsc" , stringRep IpsepOverlap "ipsep" ] -- ----------------------------------------------------------------------------- data LayerRange = LRID LayerID | LRS LayerID String LayerID deriving (Eq, Ord, Show, Read) instance PrintDot LayerRange where unqtDot (LRID lid) = unqtDot lid unqtDot (LRS id1 s id2) = unqtDot id1 <> unqtDot s <> unqtDot id2 toDot (LRID lid) = toDot lid toDot lrs = doubleQuotes $ unqtDot lrs instance ParseDot LayerRange where parseUnqt = do id1 <- parseUnqt s <- parseLayerSep id2 <- parseUnqt return $ LRS id1 s id2 `onFail` liftM LRID parseUnqt parse = quotedParse ( do id1 <- parseUnqt s <- parseLayerSep id2 <- parseUnqt return $ LRS id1 s id2 ) `onFail` liftM LRID parse parseLayerSep :: Parse String parseLayerSep = many1 . oneOf $ map character defLayerSep defLayerSep :: [Char] defLayerSep = [' ', ':', '\t'] parseLayerName :: Parse String parseLayerName = many1 . orQuote $ satisfy (liftM2 (&&) notLayerSep ((/=) quoteChar)) parseLayerName' :: Parse String parseLayerName' = stringBlock `onFail` quotedParse parseLayerName notLayerSep :: Char -> Bool notLayerSep = flip notElem defLayerSep -- | You should not have any quote characters for the 'LRName' option, -- as it won't be parseable. data LayerID = AllLayers | LRInt Int | LRName String deriving (Eq, Ord, Show, Read) instance PrintDot LayerID where unqtDot AllLayers = text "all" unqtDot (LRInt n) = unqtDot n unqtDot (LRName nm) = unqtDot nm toDot (LRName nm) = toDot nm -- Other two don't need quotes toDot li = unqtDot li instance ParseDot LayerID where parseUnqt = liftM checkLayerName parseLayerName -- tests for Int and All parse = oneOf [ liftM checkLayerName parseLayerName' , liftM LRInt parse -- Mainly for unquoted case. ] checkLayerName :: String -> LayerID checkLayerName str = maybe checkAll LRInt $ stringToInt str where checkAll = if map toLower str == "all" then AllLayers else LRName str -- | The list represent (Separator, Name). You should not have any -- quote characters for any of the 'String's, since there are -- parsing problems with them. data LayerList = LL String [(String, String)] deriving (Eq, Ord, Show, Read) instance PrintDot LayerList where unqtDot (LL l1 ols) = unqtDot l1 <> hcat (map subLL ols) where subLL (s, l) = unqtDot s <> unqtDot l toDot (LL l1 []) = toDot l1 -- Might not need quotes, but probably will. toDot ll = doubleQuotes $ unqtDot ll instance ParseDot LayerList where parseUnqt = do l1 <- parseLayerName ols <- many $ do s <- parseLayerSep lnm <- parseLayerName return (s, lnm) return $ LL l1 ols parse = quotedParse parseUnqt `onFail` liftM (flip LL []) (parseLayerName' `onFail` numString) -- ----------------------------------------------------------------------------- data OutputMode = BreadthFirst | NodesFirst | EdgesFirst deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot OutputMode where unqtDot BreadthFirst = text "breadthfirst" unqtDot NodesFirst = text "nodesfirst" unqtDot EdgesFirst = text "edgesfirst" instance ParseDot OutputMode where parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst" , stringRep NodesFirst "nodesfirst" , stringRep EdgesFirst "edgesfirst" ] -- ----------------------------------------------------------------------------- data Pack = DoPack | DontPack | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't. deriving (Eq, Ord, Show, Read) instance PrintDot Pack where unqtDot DoPack = unqtDot True unqtDot DontPack = unqtDot False unqtDot (PackMargin m) = unqtDot m instance ParseDot Pack where -- What happens if it parses 0? It's non-negative, but parses as False parseUnqt = oneOf [ liftM PackMargin parseUnqt , liftM (bool DontPack DoPack) onlyBool ] -- ----------------------------------------------------------------------------- data PackMode = PackNode | PackClust | PackGraph | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort -- by user, number of -- rows/cols deriving (Eq, Ord, Show, Read) instance PrintDot PackMode where unqtDot PackNode = text "node" unqtDot PackClust = text "clust" unqtDot PackGraph = text "graph" unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder $ text "array" where addNum = maybe id (flip (<>) . unqtDot) mi isUnder = if c || u then flip (<>) $ char '_' else id isC = if c then flip (<>) $ char 'c' else id isU = if u then flip (<>) $ char 'u' else id instance ParseDot PackMode where parseUnqt = oneOf [ stringRep PackNode "node" , stringRep PackClust "clust" , stringRep PackGraph "graph" , do string "array" mcu <- optional $ do character '_' many1 $ satisfy isCU let c = hasCharacter mcu 'c' u = hasCharacter mcu 'u' mi <- optional parseUnqt return $ PackArray c u mi ] where hasCharacter ms c = maybe False (elem c) ms -- Also checks and removes quote characters isCU = flip elem ['c', 'u'] -- ----------------------------------------------------------------------------- data Pos = PointPos Point | SplinePos [Spline] deriving (Eq, Ord, Show, Read) instance PrintDot Pos where unqtDot (PointPos p) = unqtDot p unqtDot (SplinePos ss) = unqtDot ss toDot (PointPos p) = toDot p toDot (SplinePos ss) = toDot ss instance ParseDot Pos where -- Have to be careful with this: if we try to parse points first, -- then a spline with no start and end points will erroneously get -- parsed as a point and then the parser will crash as it expects -- a closing quote character... parseUnqt = do splns <- parseUnqt case splns of [Spline Nothing Nothing [p]] -> return $ PointPos p _ -> return $ SplinePos splns parse = quotedParse parseUnqt -- ----------------------------------------------------------------------------- -- | Controls how (and if) edges are represented. data EdgeType = SplineEdges | LineEdges | NoEdges | PolyLine | CompoundEdge -- ^ fdp only deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot EdgeType where unqtDot SplineEdges = toDot True unqtDot LineEdges = toDot False unqtDot NoEdges = empty unqtDot PolyLine = text "polyline" unqtDot CompoundEdge = text "compound" toDot NoEdges = doubleQuotes empty toDot et = unqtDot et instance ParseDot EdgeType where -- Can't parse NoEdges without quotes. parseUnqt = oneOf [ liftM (bool LineEdges SplineEdges) parse , stringRep SplineEdges "spline" , stringRep LineEdges "line" , stringRep PolyLine "polyline" , stringRep CompoundEdge "compound" ] parse = stringRep NoEdges "\"\"" `onFail` optionalQuoted parseUnqt -- ----------------------------------------------------------------------------- -- | Upper-case first character is major order; -- lower-case second character is minor order. data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot PageDir where unqtDot Bl = text "BL" unqtDot Br = text "BR" unqtDot Tl = text "TL" unqtDot Tr = text "TR" unqtDot Rb = text "RB" unqtDot Rt = text "RT" unqtDot Lb = text "LB" unqtDot Lt = text "LT" instance ParseDot PageDir where parseUnqt = oneOf [ stringRep Bl "BL" , stringRep Br "BR" , stringRep Tl "TL" , stringRep Tr "TR" , stringRep Rb "RB" , stringRep Rt "RT" , stringRep Lb "LB" , stringRep Lt "LT" ] -- ----------------------------------------------------------------------------- -- | The number of points in the list must be equivalent to 1 mod 3; -- note that this is not checked. data Spline = Spline (Maybe Point) (Maybe Point) [Point] deriving (Eq, Ord, Show, Read) instance PrintDot Spline where unqtDot (Spline ms me ps) = addS . addE . hsep $ map unqtDot ps where addP t = maybe id ((<+>) . commaDel t) addS = addP 's' ms addE = addP 'e' me toDot = doubleQuotes . unqtDot unqtListToDot = hcat . punctuate semi . map unqtDot listToDot = doubleQuotes . unqtListToDot instance ParseDot Spline where parseUnqt = do ms <- parseP 's' me <- parseP 'e' ps <- sepBy1 parseUnqt whitespace return $ Spline ms me ps where parseP t = optional $ do character t parseComma parseUnqt `discard` whitespace parse = quotedParse parseUnqt parseUnqtList = sepBy1 parseUnqt (character ';') -- ----------------------------------------------------------------------------- data QuadType = NormalQT | FastQT | NoQT deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot QuadType where unqtDot NormalQT = text "normal" unqtDot FastQT = text "fast" unqtDot NoQT = text "none" instance ParseDot QuadType where -- Have to take into account the slightly different interpretation -- of Bool used as an option for parsing QuadType parseUnqt = oneOf [ stringRep NormalQT "normal" , stringRep FastQT "fast" , stringRep NoQT "none" , character '2' >> return FastQT -- weird bool , liftM (bool NoQT NormalQT) parse ] -- ----------------------------------------------------------------------------- -- | Specify the root node either as a Node attribute or a Graph attribute. data Root = IsCentral -- ^ For Nodes only | NotCentral -- ^ For Nodes only | NodeName String -- ^ For Graphs only deriving (Eq, Ord, Show, Read) instance PrintDot Root where unqtDot IsCentral = unqtDot True unqtDot NotCentral = unqtDot False unqtDot (NodeName n) = unqtDot n toDot (NodeName n) = toDot n toDot r = unqtDot r instance ParseDot Root where parseUnqt = liftM (bool NotCentral IsCentral) onlyBool `onFail` liftM NodeName parseUnqt parse = optionalQuoted (liftM (bool NotCentral IsCentral) onlyBool) `onFail` liftM NodeName parse -- ----------------------------------------------------------------------------- data RankType = SameRank | MinRank | SourceRank | MaxRank | SinkRank deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot RankType where unqtDot SameRank = text "same" unqtDot MinRank = text "min" unqtDot SourceRank = text "source" unqtDot MaxRank = text "max" unqtDot SinkRank = text "sink" instance ParseDot RankType where parseUnqt = oneOf [ stringRep SameRank "same" , stringRep MinRank "min" , stringRep SourceRank "source" , stringRep MaxRank "max" , stringRep SinkRank "sink" ] -- ----------------------------------------------------------------------------- data RankDir = FromTop | FromLeft | FromBottom | FromRight deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot RankDir where unqtDot FromTop = text "TB" unqtDot FromLeft = text "LR" unqtDot FromBottom = text "BT" unqtDot FromRight = text "RL" instance ParseDot RankDir where parseUnqt = oneOf [ stringRep FromTop "TB" , stringRep FromLeft "LR" , stringRep FromBottom "BT" , stringRep FromRight "RL" ] -- ----------------------------------------------------------------------------- data Shape = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/. | Polygon | Ellipse | Circle | PointShape | Egg | Triangle | PlainText -- ^ Has synonym of /none/. | DiamondShape | Trapezium | Parallelogram | House | Pentagon | Hexagon | Septagon | Octagon | DoubleCircle | DoubleOctagon | TripleOctagon | InvTriangle | InvTrapezium | InvHouse | MDiamond | MSquare | MCircle | Note | Tab | Folder | Box3D | Component deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot Shape where unqtDot BoxShape = text "box" unqtDot Polygon = text "polygon" unqtDot Ellipse = text "ellipse" unqtDot Circle = text "circle" unqtDot PointShape = text "point" unqtDot Egg = text "egg" unqtDot Triangle = text "triangle" unqtDot PlainText = text "plaintext" unqtDot DiamondShape = text "diamond" unqtDot Trapezium = text "trapezium" unqtDot Parallelogram = text "parallelogram" unqtDot House = text "house" unqtDot Pentagon = text "pentagon" unqtDot Hexagon = text "hexagon" unqtDot Septagon = text "septagon" unqtDot Octagon = text "octagon" unqtDot DoubleCircle = text "doublecircle" unqtDot DoubleOctagon = text "doubleoctagon" unqtDot TripleOctagon = text "tripleoctagon" unqtDot InvTriangle = text "invtriangle" unqtDot InvTrapezium = text "invtrapezium" unqtDot InvHouse = text "invhouse" unqtDot MDiamond = text "Mdiamond" unqtDot MSquare = text "Msquare" unqtDot MCircle = text "Mcircle" unqtDot Note = text "note" unqtDot Tab = text "tab" unqtDot Folder = text "folder" unqtDot Box3D = text "box3d" unqtDot Component = text "component" instance ParseDot Shape where parseUnqt = oneOf [ stringRep Box3D "box3d" -- Parse this before "box" , stringReps BoxShape ["box","rectangle","rect"] , stringRep Polygon "polygon" , stringRep Ellipse "ellipse" , stringRep Circle "circle" , stringRep PointShape "point" , stringRep Egg "egg" , stringRep Triangle "triangle" , stringReps PlainText ["plaintext","none"] , stringRep DiamondShape "diamond" , stringRep Trapezium "trapezium" , stringRep Parallelogram "parallelogram" , stringRep House "house" , stringRep Pentagon "pentagon" , stringRep Hexagon "hexagon" , stringRep Septagon "septagon" , stringRep Octagon "octagon" , stringRep DoubleCircle "doublecircle" , stringRep DoubleOctagon "doubleoctagon" , stringRep TripleOctagon "tripleoctagon" , stringRep InvTriangle "invtriangle" , stringRep InvTrapezium "invtrapezium" , stringRep InvHouse "invhouse" , stringRep MDiamond "Mdiamond" , stringRep MSquare "Msquare" , stringRep MCircle "Mcircle" , stringRep Note "note" , stringRep Tab "tab" , stringRep Folder "folder" , stringRep Component "component" ] -- ----------------------------------------------------------------------------- data SmoothType = NoSmooth | AvgDist | GraphDist | PowerDist | RNG | Spring | TriangleSmooth deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot SmoothType where unqtDot NoSmooth = text "none" unqtDot AvgDist = text "avg_dist" unqtDot GraphDist = text "graph_dist" unqtDot PowerDist = text "power_dist" unqtDot RNG = text "rng" unqtDot Spring = text "spring" unqtDot TriangleSmooth = text "triangle" instance ParseDot SmoothType where parseUnqt = oneOf [ stringRep NoSmooth "none" , stringRep AvgDist "avg_dist" , stringRep GraphDist "graph_dist" , stringRep PowerDist "power_dist" , stringRep RNG "rng" , stringRep Spring "spring" , stringRep TriangleSmooth "triangle" ] -- ----------------------------------------------------------------------------- data StartType = StartStyle STStyle | StartSeed Int | StartStyleSeed STStyle Int deriving (Eq, Ord, Show, Read) instance PrintDot StartType where unqtDot (StartStyle ss) = unqtDot ss unqtDot (StartSeed s) = unqtDot s unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s instance ParseDot StartType where parseUnqt = oneOf [ do ss <- parseUnqt s <- parseUnqt return $ StartStyleSeed ss s , liftM StartStyle parseUnqt , liftM StartSeed parseUnqt ] data STStyle = RegularStyle | SelfStyle | RandomStyle deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot STStyle where unqtDot RegularStyle = text "regular" unqtDot SelfStyle = text "self" unqtDot RandomStyle = text "random" instance ParseDot STStyle where parseUnqt = oneOf [ stringRep RegularStyle "regular" , stringRep SelfStyle "self" , stringRep RandomStyle "random" ] -- ----------------------------------------------------------------------------- data StyleItem = SItem StyleName [String] deriving (Eq, Ord, Show, Read) instance PrintDot StyleItem where unqtDot (SItem nm args) | null args = dnm | otherwise = dnm <> parens args' where dnm = unqtDot nm args' = hcat . punctuate comma $ map unqtDot args toDot si@(SItem nm args) | null args = toDot nm | otherwise = doubleQuotes $ unqtDot si unqtListToDot = hcat . punctuate comma . map unqtDot listToDot [SItem nm []] = toDot nm listToDot sis = doubleQuotes $ unqtListToDot sis instance ParseDot StyleItem where parseUnqt = do nm <- parseUnqt args <- tryParseList' parseArgs return $ SItem nm args parse = quotedParse (liftM2 SItem parseUnqt parseArgs) `onFail` liftM (flip SItem []) parse parseUnqtList = sepBy1 parseUnqt parseComma parseList = quotedParse parseUnqtList `onFail` -- Might not necessarily need to be quoted if a singleton... liftM return parse parseArgs :: Parse [String] parseArgs = bracketSep (character '(') parseComma (character ')') parseStyleName data StyleName = Dashed -- ^ Nodes and Edges | Dotted -- ^ Nodes and Edges | Solid -- ^ Nodes and Edges | Bold -- ^ Nodes and Edges | Invisible -- ^ Nodes and Edges | Filled -- ^ Nodes and Clusters | Diagonals -- ^ Nodes only | Rounded -- ^ Nodes and Clusters | DD String -- ^ Device Dependent deriving (Eq, Ord, Show, Read) instance PrintDot StyleName where unqtDot Dashed = text "dashed" unqtDot Dotted = text "dotted" unqtDot Solid = text "solid" unqtDot Bold = text "bold" unqtDot Invisible = text "invis" unqtDot Filled = text "filled" unqtDot Diagonals = text "diagonals" unqtDot Rounded = text "rounded" unqtDot (DD nm) = unqtDot nm toDot (DD nm) = toDot nm toDot sn = unqtDot sn instance ParseDot StyleName where parseUnqt = liftM checkDD parseStyleName parse = liftM checkDD $ quotedParse parseStyleName `onFail` -- In case a singleton DD is at the end of an attribute list. do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' ', ']'] r <- many (orQuote $ noneOf [quoteChar, '(', ')', ',', ']']) return $ f:r checkDD :: String -> StyleName checkDD str = case map toLower str of "dashed" -> Dashed "dotted" -> Dotted "solid" -> Solid "bold" -> Bold "invis" -> Invisible "filled" -> Filled "diagonals" -> Diagonals "rounded" -> Rounded _ -> DD str parseStyleName :: Parse String parseStyleName = do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' '] r <- many (orQuote $ noneOf [quoteChar, '(', ')', ',']) return $ f:r -- ----------------------------------------------------------------------------- newtype PortPos = PP CompassPoint deriving (Eq, Ord, Show, Read) instance PrintDot PortPos where unqtDot (PP cp) = unqtDot cp toDot (PP cp) = toDot cp instance ParseDot PortPos where parseUnqt = liftM PP parseUnqt data CompassPoint = North | NorthEast | East | SouthEast | South | SouthWest | West | NorthWest | CenterPoint | NoCP deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot CompassPoint where unqtDot NorthEast = text "ne" unqtDot NorthWest = text "nw" unqtDot North = text "n" unqtDot East = text "e" unqtDot SouthEast = text "se" unqtDot SouthWest = text "sw" unqtDot South = text "s" unqtDot West = text "w" unqtDot CenterPoint = text "c" unqtDot NoCP = text "_" instance ParseDot CompassPoint where -- Have to take care of longer parsing values first. parseUnqt = oneOf [ stringRep NorthEast "ne" , stringRep NorthWest "nw" , stringRep North "n" , stringRep SouthEast "se" , stringRep SouthWest "sw" , stringRep South "s" , stringRep East "e" , stringRep West "w" , stringRep CenterPoint "c" , stringRep NoCP "_" ] -- ----------------------------------------------------------------------------- data ViewPort = VP { wVal :: Double , hVal :: Double , zVal :: Double , focus :: Maybe FocusType } deriving (Eq, Ord, Show, Read) instance PrintDot ViewPort where unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot) $ focus vp where vs = hcat . punctuate comma $ map (unqtDot . flip ($) vp) [wVal, hVal, zVal] toDot = doubleQuotes . unqtDot instance ParseDot ViewPort where parseUnqt = do wv <- parseUnqt parseComma hv <- parseUnqt parseComma zv <- parseUnqt mf <- optional $ parseComma >> parseUnqt return $ VP wv hv zv mf parse = quotedParse parseUnqt data FocusType = XY Point | NodeFocus String deriving (Eq, Ord, Show, Read) instance PrintDot FocusType where unqtDot (XY p) = unqtDot p unqtDot (NodeFocus nm) = unqtDot nm toDot (XY p) = toDot p toDot (NodeFocus nm) = toDot nm instance ParseDot FocusType where parseUnqt = liftM XY parseUnqt `onFail` liftM NodeFocus parseUnqt parse = liftM XY parse `onFail` liftM NodeFocus parse -- ----------------------------------------------------------------------------- data VerticalPlacement = VTop | VCenter -- ^ Only valid for Nodes. | VBottom deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot VerticalPlacement where unqtDot VTop = char 't' unqtDot VCenter = char 'c' unqtDot VBottom = char 'b' instance ParseDot VerticalPlacement where parseUnqt = oneOf [ stringRep VTop "t" , stringRep VCenter "c" , stringRep VBottom "b" ] -- ----------------------------------------------------------------------------- data ScaleType = UniformScale | NoScale | FillWidth | FillHeight | FillBoth deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot ScaleType where unqtDot UniformScale = unqtDot True unqtDot NoScale = unqtDot False unqtDot FillWidth = text "width" unqtDot FillHeight = text "height" unqtDot FillBoth = text "both" instance ParseDot ScaleType where parseUnqt = oneOf [ stringRep UniformScale "true" , stringRep NoScale "false" , stringRep FillWidth "width" , stringRep FillHeight "height" , stringRep FillBoth "both" ] -- ----------------------------------------------------------------------------- data Justification = JLeft | JRight | JCenter deriving (Eq, Ord, Bounded, Enum, Show, Read) instance PrintDot Justification where unqtDot JLeft = char 'l' unqtDot JRight = char 'r' unqtDot JCenter = char 'c' instance ParseDot Justification where parseUnqt = oneOf [ stringRep JLeft "l" , stringRep JRight "r" , stringRep JCenter "c" ] -- ----------------------------------------------------------------------------- data Ratios = AspectRatio Double | FillRatio | CompressRatio | ExpandRatio | AutoRatio deriving (Eq, Ord, Show, Read) instance PrintDot Ratios where unqtDot (AspectRatio r) = unqtDot r unqtDot FillRatio = text "fill" unqtDot CompressRatio = text "compress" unqtDot ExpandRatio = text "expand" unqtDot AutoRatio = text "auto" instance ParseDot Ratios where parseUnqt = oneOf [ liftM AspectRatio parseUnqt , stringRep FillRatio "fill" , stringRep CompressRatio "compress" , stringRep ExpandRatio "expand" , stringRep AutoRatio "auto" ] haskell-src-exts-1.14.0/Test/examples/SingleClassAsst.hs0000644000000000000000000000006412204617765021321 0ustar0000000000000000module Test where foo :: (Eq a) => a -> a foo x = xhaskell-src-exts-1.14.0/Test/examples/LambdaCase.hs0000644000000000000000000000015512204617765020234 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} module LambdaCase where foo = \case Nothing -> e1 Just e2 -> e2 haskell-src-exts-1.14.0/Test/examples/SimpleDeriving.hs0000644000000000000000000000002612204617765021176 0ustar0000000000000000data T = T deriving Eqhaskell-src-exts-1.14.0/Test/examples/EmptyList.hs0000644000000000000000000000004312204617765020206 0ustar0000000000000000module EmptyList where eAttrs = []haskell-src-exts-1.14.0/Test/examples/SpecializeInstance.hs0000644000000000000000000000031712204617765022035 0ustar0000000000000000instance Sized a => Sized (Digit a) where {-# SPECIALIZE instance Sized (Digit (Elem a)) #-} {-# SPECIALIZE instance Sized (Digit (Node a)) #-} size xs = foldl (\ i x -> i + size x) 0 xshaskell-src-exts-1.14.0/Test/examples/FFIExtensions.hs0000644000000000000000000000034112204617765020741 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI, CApiFFI #-} module FFIExtensions where foreign import ccall interruptible "sleep" sleep :: CUint -> IO CUint foreign import capi "header.h f" f :: CInt -> IO CInt haskell-src-exts-1.14.0/Test/examples/Bug.hs0000644000000000000000000000007612204617765016777 0ustar0000000000000000import Test.QuickCheck -- prop_susShortest = 2 > 1 ==> 1 /= 2 haskell-src-exts-1.14.0/Test/examples/GroupKeyword.hs0000644000000000000000000000014512204617765020720 0ustar0000000000000000-- {-# LANGUAGE TransformListComp #-} module GroupKeyword where a = map head $ group $ sort [1..100]haskell-src-exts-1.14.0/Test/examples/InfixParser.hs0000644000000000000000000000021012204617765020502 0ustar0000000000000000module InfixParser where type Parse a b = [a] -> [(b, [a])] (<|>) :: Parse a b -> Parse a b -> Parse a b (p1 <|> p2) i = p1 i ++ p2 i haskell-src-exts-1.14.0/Test/examples/ByteStringUtils.hs0000644000000000000000000004715012204617765021401 0ustar0000000000000000{-# LANGUAGE BangPatterns, ForeignFunctionInterface, CPP #-} ----------------------------------------------------------------------------- -- | -- Module : ByteStringUtils -- Copyright : (c) The University of Glasgow 2001, -- David Roundy 2003-2005 -- License : GPL (I'm happy to also license this file BSD style but don't -- want to bother distributing two license files with darcs. -- -- Maintainer : droundy@abridgegame.org -- Stability : experimental -- Portability : portable -- -- GZIp and MMap IO for ByteStrings, and miscellaneous functions for Data.ByteString -- module ByteStringUtils ( unsafeWithInternals, unpackPSfromUTF8, -- IO with mmap or gzip gzReadFilePS, mmapFilePS, gzWriteFilePS, gzWriteFilePSs, -- list utilities ifHeadThenTail, dropSpace, breakSpace, linesPS, unlinesPS, hashPS, breakFirstPS, breakLastPS, substrPS, readIntPS, is_funky, fromHex2PS, fromPS2Hex, betweenLinesPS, break_after_nth_newline, break_before_nth_newline, intercalate ) where import Prelude hiding ( catch ) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Internal as BI import Data.ByteString (intercalate, uncons) import Data.ByteString.Internal (fromForeignPtr) -- #if defined (HAVE_MMAP) || ! defined (HAVE_HASKELL_ZLIB) import Control.Exception ( catch ) -- #endif import System.IO import System.IO.Unsafe ( unsafePerformIO ) import Foreign.Storable ( peekElemOff, peek ) import Foreign.Marshal.Alloc ( free ) import Foreign.Marshal.Array ( mallocArray, peekArray, advancePtr ) import Foreign.C.Types ( CInt ) import Data.Bits ( rotateL ) import Data.Char ( chr, ord, isSpace ) import Data.Word ( Word8 ) import Data.Int ( Int32 ) import Control.Monad ( when ) -- #ifndef HAVE_HASKELL_ZLIB import Foreign.Ptr ( nullPtr ) import Foreign.ForeignPtr ( ForeignPtr ) -- #endif import Foreign.Ptr ( plusPtr, Ptr ) import Foreign.ForeignPtr ( withForeignPtr ) -- #ifdef DEBUG_PS import Foreign.ForeignPtr ( addForeignPtrFinalizer ) import Foreign.Ptr ( FunPtr ) -- #endif -- #if HAVE_HASKELL_ZLIB import qualified Data.ByteString.Lazy as BL import qualified Codec.Compression.GZip as GZ -- #else import Foreign.C.String ( CString, withCString ) -- #endif -- #ifdef HAVE_MMAP import System.IO.MMap( mmapFileByteString ) import System.Mem( performGC ) import System.Posix.Files( fileSize, getSymbolicLinkStatus ) -- #endif -- ----------------------------------------------------------------------------- -- obsolete debugging code -- # ifndef HAVE_HASKELL_ZLIB debugForeignPtr :: ForeignPtr a -> String -> IO () -- #ifdef DEBUG_PS foreign import ccall unsafe "static fpstring.h debug_alloc" debug_alloc :: Ptr a -> CString -> IO () foreign import ccall unsafe "static fpstring.h & debug_free" debug_free :: FunPtr (Ptr a -> IO ()) debugForeignPtr fp n = withCString n $ \cname-> withForeignPtr fp $ \p-> do debug_alloc p cname addForeignPtrFinalizer debug_free fp -- #else debugForeignPtr _ _ = return () -- #endif -- #endif -- ----------------------------------------------------------------------------- -- unsafeWithInternals -- | Do something with the internals of a PackedString. Beware of -- altering the contents! unsafeWithInternals :: B.ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a unsafeWithInternals ps f = case BI.toForeignPtr ps of (fp,s,l) -> withForeignPtr fp $ \p -> f (p `plusPtr` s) l -- | readIntPS skips any whitespace at the beginning of its argument, and -- reads an Int from the beginning of the PackedString. If there is no -- integer at the beginning of the string, it returns Nothing, otherwise it -- just returns the int read, along with a B.ByteString containing the -- remainder of its input. readIntPS :: B.ByteString -> Maybe (Int, B.ByteString) readIntPS = BC.readInt . BC.dropWhile isSpace -- ----------------------------------------------------------------------------- -- Destructor functions (taking PackedStrings apart) unpackPSfromUTF8 :: B.ByteString -> String unpackPSfromUTF8 ps = case BI.toForeignPtr ps of (_,_, 0) -> "" (x,s,l) -> unsafePerformIO $ withForeignPtr x $ \p-> do outbuf <- mallocArray l lout <- fromIntegral `fmap` utf8_to_ints outbuf (p `plusPtr` s) (fromIntegral l) when (lout < 0) $ error "Bad UTF8!" str <- (map (chr . fromIntegral)) `fmap` peekArray lout outbuf free outbuf return str foreign import ccall unsafe "static fpstring.h utf8_to_ints" utf8_to_ints :: Ptr Int -> Ptr Word8 -> CInt -> IO CInt -- ----------------------------------------------------------------------------- -- List-mimicking functions for PackedStrings {-# INLINE ifHeadThenTail #-} ifHeadThenTail :: Word8 -> B.ByteString -> Maybe B.ByteString ifHeadThenTail c s = case uncons s of Just (w, t) | w == c -> Just t _ -> Nothing ------------------------------------------------------------------------ -- A reimplementation of Data.ByteString.Char8.dropSpace, but -- specialised to darcs' need for a 4 way isspace. -- -- TODO: if it is safe to use the expanded definition of isSpaceWord8 -- provided by Data.ByteString.Char8, then all this can go. -- A locale-independent isspace(3) so patches are interpreted the same everywhere. -- ((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) == '\r') isSpaceWord8 :: Word8 -> Bool isSpaceWord8 w = w == 0x20 || -- ' ' w == 0x09 || -- '\t' w == 0x0A || -- '\n' w == 0x0D -- '\r' {-# INLINE isSpaceWord8 #-} firstnonspace :: Ptr Word8 -> Int -> Int -> IO Int firstnonspace !ptr !n !m | n >= m = return n | otherwise = do w <- peekElemOff ptr n if isSpaceWord8 w then firstnonspace ptr (n+1) m else return n firstspace :: Ptr Word8 -> Int -> Int -> IO Int firstspace !ptr !n !m | n >= m = return n | otherwise = do w <- peekElemOff ptr n if (not . isSpaceWord8) w then firstspace ptr (n+1) m else return n -- | 'dropSpace' efficiently returns the 'ByteString' argument with -- white space Chars removed from the front. It is more efficient than -- calling dropWhile for removing whitespace. I.e. -- -- > dropWhile isSpace == dropSpace -- dropSpace :: B.ByteString -> B.ByteString dropSpace (BI.PS x s l) = BI.inlinePerformIO $ withForeignPtr x $ \p -> do i <- firstnonspace (p `plusPtr` s) 0 l return $! if i == l then B.empty else BI.PS x (s+i) (l-i) {-# INLINE dropSpace #-} -- | 'breakSpace' returns the pair of ByteStrings when the argument is -- broken at the first whitespace byte. I.e. -- -- > break isSpace == breakSpace -- breakSpace :: B.ByteString -> (B.ByteString,B.ByteString) breakSpace (BI.PS x s l) = BI.inlinePerformIO $ withForeignPtr x $ \p -> do i <- firstspace (p `plusPtr` s) 0 l return $! case () of {_ | i == 0 -> (B.empty, BI.PS x s l) | i == l -> (BI.PS x s l, B.empty) | otherwise -> (BI.PS x s i, BI.PS x (s+i) (l-i)) } {-# INLINE breakSpace #-} ------------------------------------------------------------------------ {-# INLINE is_funky #-} is_funky :: B.ByteString -> Bool is_funky ps = case BI.toForeignPtr ps of (x,s,l) -> unsafePerformIO $ withForeignPtr x $ \p-> (/=0) `fmap` has_funky_char (p `plusPtr` s) (fromIntegral l) foreign import ccall unsafe "fpstring.h has_funky_char" has_funky_char :: Ptr Word8 -> CInt -> IO CInt ------------------------------------------------------------------------ -- ByteString rewrites break (=='x') to breakByte 'x' -- break ((==) x) = breakChar x -- break (==x) = breakChar x -- {- {-# INLINE breakOnPS #-} breakOnPS :: Char -> B.ByteString -> (B.ByteString, B.ByteString) breakOnPS c p = case BC.elemIndex c p of Nothing -> (p, BC.empty) Just n -> (B.take n p, B.drop n p) -} {-# INLINE hashPS #-} hashPS :: B.ByteString -> Int32 hashPS ps = case BI.toForeignPtr ps of (x,s,l) -> unsafePerformIO $ withForeignPtr x $ \p-> do hash (p `plusPtr` s) l hash :: Ptr Word8 -> Int -> IO Int32 hash ptr len = f (0 :: Int32) ptr len where f h _ 0 = return h f h p n = do x <- peek p let !h' = (fromIntegral x) + (rotateL h 8) f h' (p `advancePtr` 1) (n-1) {-# INLINE substrPS #-} substrPS :: B.ByteString -> B.ByteString -> Maybe Int substrPS tok str | B.null tok = Just 0 | B.length tok > B.length str = Nothing | otherwise = do n <- BC.elemIndex (BC.head tok) str let ttok = B.tail tok reststr = B.drop (n+1) str if ttok == B.take (B.length ttok) reststr then Just n else ((n+1)+) `fmap` substrPS tok reststr ------------------------------------------------------------------------ -- TODO: replace breakFirstPS and breakLastPS with definitions based on -- ByteString's break/breakEnd {-# INLINE breakFirstPS #-} breakFirstPS :: Char -> B.ByteString -> Maybe (B.ByteString,B.ByteString) breakFirstPS c p = case BC.elemIndex c p of Nothing -> Nothing Just n -> Just (B.take n p, B.drop (n+1) p) {-# INLINE breakLastPS #-} breakLastPS :: Char -> B.ByteString -> Maybe (B.ByteString,B.ByteString) breakLastPS c p = case BC.elemIndexEnd c p of Nothing -> Nothing Just n -> Just (B.take n p, B.drop (n+1) p) -- TODO: rename {-# INLINE linesPS #-} linesPS :: B.ByteString -> [B.ByteString] linesPS ps | B.null ps = [B.empty] | otherwise = BC.split '\n' ps {- QuickCheck property: import Test.QuickCheck import qualified Data.ByteString.Char8 as BC import Data.Char instance Arbitrary BC.ByteString where arbitrary = fmap BC.pack arbitrary instance Arbitrary Char where arbitrary = chr `fmap` choose (32,127) deepCheck = check (defaultConfig { configMaxTest = 10000}) testLines = deepCheck (\x -> (linesPS x == linesPSOld x)) linesPSOld ps = case BC.elemIndex '\n' ps of Nothing -> [ps] Just n -> B.take n ps : linesPS (B.drop (n+1) ps) -} {-| This function acts exactly like the "Prelude" unlines function, or like "Data.ByteString.Char8" 'unlines', but with one important difference: it will produce a string which may not end with a newline! That is: > unlinesPS ["foo", "bar"] evaluates to \"foo\\nbar\", not \"foo\\nbar\\n\"! This point should hold true for 'linesPS' as well. TODO: rename this function. -} unlinesPS :: [B.ByteString] -> B.ByteString unlinesPS [] = BC.empty unlinesPS x = BC.init $ BC.unlines x {-# INLINE unlinesPS #-} {- QuickCheck property: testUnlines = deepCheck (\x -> (unlinesPS x == unlinesPSOld x)) unlinesPSOld ss = BC.concat $ intersperse_newlines ss where intersperse_newlines (a:b:s) = a : newline : intersperse_newlines (b:s) intersperse_newlines s = s newline = BC.pack "\n" -} -- ----------------------------------------------------------------------------- -- gzReadFilePS -- | Read an entire file, which may or may not be gzip compressed, directly -- into a 'B.ByteString'. -- #ifndef HAVE_HASKELL_ZLIB foreign import ccall unsafe "static zlib.h gzopen" c_gzopen :: CString -> CString -> IO (Ptr ()) foreign import ccall unsafe "static zlib.h gzclose" c_gzclose :: Ptr () -> IO () foreign import ccall unsafe "static zlib.h gzread" c_gzread :: Ptr () -> Ptr Word8 -> CInt -> IO CInt foreign import ccall unsafe "static zlib.h gzwrite" c_gzwrite :: Ptr () -> Ptr Word8 -> CInt -> IO CInt -- #endif gzReadFilePS :: FilePath -> IO B.ByteString gzReadFilePS f = do h <- openBinaryFile f ReadMode header <- B.hGet h 2 if header /= BC.pack "\31\139" then do hClose h mmapFilePS f else do hSeek h SeekFromEnd (-4) len <- hGetLittleEndInt h hClose h -- #ifdef HAVE_HASKELL_ZLIB -- Passing the length to GZ.decompressWith means -- that BL.toChunks only produces one chunk, which in turn -- means that B.concat won't need to copy data. -- If the length is wrong this will just affect efficiency, not correctness let decompress = GZ.decompressWith GZ.defaultDecompressParams { GZ.decompressBufferSize = len } fmap (B.concat . BL.toChunks . decompress) $ -- #ifdef HAVE_OLD_BYTESTRING -- bytestring < 0.9.1 had a bug where it did not know to close handles upon EOF -- performance would be better with a newer bytestring and lazy -- readFile below -- ratify readFile: comment fmap (BL.fromChunks . (:[])) $ B.readFile f -- ratify readFile: immediately consumed -- #else BL.readFile f -- ratify readFile: immediately consumed by the conversion to a strict bytestring -- #endif -- #else withCString f $ \fstr-> withCString "rb" $ \rb-> do gzf <- c_gzopen fstr rb when (gzf == nullPtr) $ fail $ "problem opening file "++f fp <- BI.mallocByteString len debugForeignPtr fp $ "gzReadFilePS "++f lread <- withForeignPtr fp $ \p -> c_gzread gzf p (fromIntegral len) c_gzclose gzf when (fromIntegral lread /= len) $ fail $ "problem gzreading file "++f return $ fromForeignPtr fp 0 len -- #endif hGetLittleEndInt :: Handle -> IO Int hGetLittleEndInt h = do b1 <- ord `fmap` hGetChar h b2 <- ord `fmap` hGetChar h b3 <- ord `fmap` hGetChar h b4 <- ord `fmap` hGetChar h return $ b1 + 256*b2 + 65536*b3 + 16777216*b4 gzWriteFilePS :: FilePath -> B.ByteString -> IO () gzWriteFilePS f ps = gzWriteFilePSs f [ps] gzWriteFilePSs :: FilePath -> [B.ByteString] -> IO () gzWriteFilePSs f pss = -- #ifdef HAVE_HASKELL_ZLIB BL.writeFile f $ GZ.compress $ BL.fromChunks pss -- #else withCString f $ \fstr -> withCString "wb" $ \wb -> do gzf <- c_gzopen fstr wb when (gzf == nullPtr) $ fail $ "problem gzopening file for write: "++f mapM_ (gzWriteToGzf gzf) pss `catch` \_ -> fail $ "problem gzwriting file: "++f c_gzclose gzf gzWriteToGzf :: Ptr () -> B.ByteString -> IO () gzWriteToGzf gzf ps = case BI.toForeignPtr ps of (_,_,0) -> return () -- avoid calling gzwrite with 0 length this would -- trouble on some versions of zlib, and is always -- unnecessary. (x,s,l) -> do lw <- withForeignPtr x $ \p -> c_gzwrite gzf (p `plusPtr` s) (fromIntegral l) when (fromIntegral lw /= l) $ fail $ "problem in gzWriteToGzf" -- #endif -- ----------------------------------------------------------------------------- -- mmapFilePS -- | Like readFilePS, this reads an entire file directly into a -- 'B.ByteString', but it is even more efficient. It involves directly -- mapping the file to memory. This has the advantage that the contents of -- the file never need to be copied. Also, under memory pressure the page -- may simply be discarded, wile in the case of readFilePS it would need to -- be written to swap. If you read many small files, mmapFilePS will be -- less memory-efficient than readFilePS, since each mmapFilePS takes up a -- separate page of memory. Also, you can run into bus errors if the file -- is modified. NOTE: as with 'readFilePS', the string representation in -- the file is assumed to be ISO-8859-1. mmapFilePS :: FilePath -> IO B.ByteString -- #ifdef HAVE_MMAP mmapFilePS f = do x <- mmapFileByteString f Nothing `catch` (\_ -> do size <- fileSize `fmap` getSymbolicLinkStatus f if size == 0 then return B.empty else performGC >> mmapFileByteString f Nothing) return x -- #else mmapFilePS = B.readFile -- #endif -- ------------------------------------------------------------------------- -- fromPS2Hex foreign import ccall unsafe "static fpstring.h conv_to_hex" conv_to_hex :: Ptr Word8 -> Ptr Word8 -> CInt -> IO () fromPS2Hex :: B.ByteString -> B.ByteString fromPS2Hex ps = case BI.toForeignPtr ps of (x,s,l) -> BI.unsafeCreate (2*l) $ \p -> withForeignPtr x $ \f -> conv_to_hex p (f `plusPtr` s) $ fromIntegral l -- ------------------------------------------------------------------------- -- fromHex2PS foreign import ccall unsafe "static fpstring.h conv_from_hex" conv_from_hex :: Ptr Word8 -> Ptr Word8 -> CInt -> IO () fromHex2PS :: B.ByteString -> B.ByteString fromHex2PS ps = case BI.toForeignPtr ps of (x,s,l) -> BI.unsafeCreate (l `div` 2) $ \p -> withForeignPtr x $ \f -> conv_from_hex p (f `plusPtr` s) (fromIntegral $ l `div` 2) -- ------------------------------------------------------------------------- -- betweenLinesPS -- | betweenLinesPS returns the B.ByteString between the two lines given, -- or Nothing if they do not appear. betweenLinesPS :: B.ByteString -> B.ByteString -> B.ByteString -> Maybe (B.ByteString) betweenLinesPS start end ps = case break (start ==) (linesPS ps) of (_, _:rest@(bs1:_)) -> case BI.toForeignPtr bs1 of (ps1,s1,_) -> case break (end ==) rest of (_, bs2:_) -> case BI.toForeignPtr bs2 of (_,s2,_) -> Just $ fromForeignPtr ps1 s1 (s2 - s1) _ -> Nothing _ -> Nothing -- ------------------------------------------------------------------------- -- break_after_nth_newline break_after_nth_newline :: Int -> B.ByteString -> Maybe (B.ByteString, B.ByteString) break_after_nth_newline 0 the_ps | B.null the_ps = Just (B.empty, B.empty) break_after_nth_newline n the_ps = case BI.toForeignPtr the_ps of (fp,the_s,l) -> unsafePerformIO $ withForeignPtr fp $ \p -> do let findit 0 s | s == end = return $ Just (the_ps, B.empty) findit _ s | s == end = return Nothing findit 0 s = let left_l = s - the_s in return $ Just (fromForeignPtr fp the_s left_l, fromForeignPtr fp s (l - left_l)) findit i s = do w <- peekElemOff p s if w == nl then findit (i-1) (s+1) else findit i (s+1) nl = BI.c2w '\n' end = the_s + l findit n the_s -- ------------------------------------------------------------------------- -- break_before_nth_newline break_before_nth_newline :: Int -> B.ByteString -> (B.ByteString, B.ByteString) break_before_nth_newline 0 the_ps | B.null the_ps = (B.empty, B.empty) break_before_nth_newline n the_ps = case BI.toForeignPtr the_ps of (fp,the_s,l) -> unsafePerformIO $ withForeignPtr fp $ \p -> do let findit _ s | s == end = return (the_ps, B.empty) findit i s = do w <- peekElemOff p s if w == nl then if i == 0 then let left_l = s - the_s in return (fromForeignPtr fp the_s left_l, fromForeignPtr fp s (l - left_l)) else findit (i-1) (s+1) else findit i (s+1) nl = BI.c2w '\n' end = the_s + l findit n the_s haskell-src-exts-1.14.0/Test/examples/PrimitiveIntHexLiteral.hs0000644000000000000000000000007512204617765022666 0ustar0000000000000000{-# LANGUAGE MagicHash #-} minInt = I# (0x8000000000000000#) haskell-src-exts-1.14.0/Test/examples/IllDataTypeDecl.hs0000644000000000000000000000012412204617765021220 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} module IllDataTypeDecl where data (f :+: g) p = L haskell-src-exts-1.14.0/Test/examples/ReadP.hs0000644000000000000000000000012112204617765017244 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} newtype ReadP a = R (forall b . (a -> P b) -> P b)haskell-src-exts-1.14.0/Test/examples/TypeOperatorsTest.hs0000644000000000000000000000016012204617765021734 0ustar0000000000000000{-# LANGUAGE TypeOperators, FlexibleContexts, FlexibleInstances #-} f :: ArrowXml (~>) => a ~> a f = undefined haskell-src-exts-1.14.0/Test/examples/CParser.hs0000644000000000000000000134576612204617765017644 0ustar0000000000000000{-# OPTIONS -fglasgow-exts -cpp #-} {-# LANGUAGE MagicHash #-} module Language.C.Parser.Parser ( -- * Parse a C translation unit parseC, -- * Exposed Parsers translUnitP, extDeclP, statementP, expressionP ) where -- Relevant C99 sections: -- -- 6.5 Expressions .1 - .17 and 6.6 (almost literally) -- Supported GNU extensions: -- - Allow a compound statement as an expression -- - Various __builtin_* forms that take type parameters -- - `alignof' expression or type -- - `__extension__' to suppress warnings about extensions -- - Allow taking address of a label with: && label -- - Omitting the `then' part of conditional expressions -- - complex numbers -- -- 6.7 C Declarations .1 -.8 -- Supported GNU extensions: -- - '__thread' thread local storage (6.7.1) -- -- 6.8 Statements .1 - .8 -- Supported GNU extensions: -- - case ranges (C99 6.8.1) -- - '__label__ ident;' declarations (C99 6.8.2) -- - computed gotos (C99 6.8.6) -- -- 6.9 Translation unit -- Supported GNU extensions: -- - allow empty translation_unit -- - allow redundant ';' -- - allow extension keyword before external declaration -- - asm definitions -- -- Since some of the grammar productions are quite difficult to read, -- (especially those involved with the decleration syntax) we document them -- with an extended syntax that allows a more consise representation: -- -- Ordinary rules -- -- foo named terminal or non-terminal -- -- 'c' terminal, literal character token -- -- A B concatenation -- -- A | B alternation -- -- (A) grouping -- -- Extended rules -- -- A? optional, short hand for (A|) or [A]{ 0==A || 1==A } -- -- ... stands for some part of the grammar omitted for clarity -- -- {A} represents sequences, 0 or more. -- -- modifier which states that any permutation of the immediate subterms is valid -- -- --- TODO ---------------------------------------------------------------------- -- -- !* We ignore the C99 static keyword (see C99 6.7.5.3) -- !* We do not distinguish in the AST between incomplete array types and -- complete variable length arrays ([ '*' ] means the latter). (see C99 6.7.5.2) -- !* The AST doesn't allow recording __attribute__ of unnamed struct field -- (see , struct_default_declaring_list, struct_identifier_declarator) -- !* see `We're being far to liberal here' (... struct definition within structs) -- * Documentation isn't complete and consistent yet. import Prelude hiding (reverse) import qualified Data.List as List import Control.Monad (mplus) import Language.C.Parser.Builtin (builtinTypeNames) import Language.C.Parser.Lexer (lexC, parseError) import Language.C.Parser.Tokens (CToken(..), GnuCTok(..), posLenOfTok) import Language.C.Parser.ParserMonad (P, failP, execParser, getNewName, addTypedef, shadowTypedef, getCurrentPosition, enterScope, leaveScope, getLastToken, getSavedToken, ParseError(..)) import Language.C.Data.RList import Language.C.Data.InputStream import Language.C.Data.Ident import Language.C.Data.Name import Language.C.Data.Node import Language.C.Data.Position import Language.C.Syntax -- #if __GLASGOW_HASKELL__ >= 503 import Data.Array -- #else import Array -- #endif -- #if __GLASGOW_HASKELL__ >= 503 import GHC.Exts -- #else import GlaExts -- #endif -- parser produced by Happy Version 1.16 newtype HappyAbsSyn = HappyAbsSyn (() -> ()) happyIn7 :: (CTranslUnit) -> (HappyAbsSyn ) happyIn7 x = unsafeCoerce# x {-# INLINE happyIn7 #-} happyOut7 :: (HappyAbsSyn ) -> (CTranslUnit) happyOut7 x = unsafeCoerce# x {-# INLINE happyOut7 #-} happyIn8 :: (Reversed [CExtDecl]) -> (HappyAbsSyn ) happyIn8 x = unsafeCoerce# x {-# INLINE happyIn8 #-} happyOut8 :: (HappyAbsSyn ) -> (Reversed [CExtDecl]) happyOut8 x = unsafeCoerce# x {-# INLINE happyOut8 #-} happyIn9 :: (CExtDecl) -> (HappyAbsSyn ) happyIn9 x = unsafeCoerce# x {-# INLINE happyIn9 #-} happyOut9 :: (HappyAbsSyn ) -> (CExtDecl) happyOut9 x = unsafeCoerce# x {-# INLINE happyOut9 #-} happyIn10 :: (CFunDef) -> (HappyAbsSyn ) happyIn10 x = unsafeCoerce# x {-# INLINE happyIn10 #-} happyOut10 :: (HappyAbsSyn ) -> (CFunDef) happyOut10 x = unsafeCoerce# x {-# INLINE happyOut10 #-} happyIn11 :: (CDeclr) -> (HappyAbsSyn ) happyIn11 x = unsafeCoerce# x {-# INLINE happyIn11 #-} happyOut11 :: (HappyAbsSyn ) -> (CDeclr) happyOut11 x = unsafeCoerce# x {-# INLINE happyOut11 #-} happyIn12 :: (CStat) -> (HappyAbsSyn ) happyIn12 x = unsafeCoerce# x {-# INLINE happyIn12 #-} happyOut12 :: (HappyAbsSyn ) -> (CStat) happyOut12 x = unsafeCoerce# x {-# INLINE happyOut12 #-} happyIn13 :: (CStat) -> (HappyAbsSyn ) happyIn13 x = unsafeCoerce# x {-# INLINE happyIn13 #-} happyOut13 :: (HappyAbsSyn ) -> (CStat) happyOut13 x = unsafeCoerce# x {-# INLINE happyOut13 #-} happyIn14 :: (CStat) -> (HappyAbsSyn ) happyIn14 x = unsafeCoerce# x {-# INLINE happyIn14 #-} happyOut14 :: (HappyAbsSyn ) -> (CStat) happyOut14 x = unsafeCoerce# x {-# INLINE happyOut14 #-} happyIn15 :: (()) -> (HappyAbsSyn ) happyIn15 x = unsafeCoerce# x {-# INLINE happyIn15 #-} happyOut15 :: (HappyAbsSyn ) -> (()) happyOut15 x = unsafeCoerce# x {-# INLINE happyOut15 #-} happyIn16 :: (()) -> (HappyAbsSyn ) happyIn16 x = unsafeCoerce# x {-# INLINE happyIn16 #-} happyOut16 :: (HappyAbsSyn ) -> (()) happyOut16 x = unsafeCoerce# x {-# INLINE happyOut16 #-} happyIn17 :: (Reversed [CBlockItem]) -> (HappyAbsSyn ) happyIn17 x = unsafeCoerce# x {-# INLINE happyIn17 #-} happyOut17 :: (HappyAbsSyn ) -> (Reversed [CBlockItem]) happyOut17 x = unsafeCoerce# x {-# INLINE happyOut17 #-} happyIn18 :: (CBlockItem) -> (HappyAbsSyn ) happyIn18 x = unsafeCoerce# x {-# INLINE happyIn18 #-} happyOut18 :: (HappyAbsSyn ) -> (CBlockItem) happyOut18 x = unsafeCoerce# x {-# INLINE happyOut18 #-} happyIn19 :: (CBlockItem) -> (HappyAbsSyn ) happyIn19 x = unsafeCoerce# x {-# INLINE happyIn19 #-} happyOut19 :: (HappyAbsSyn ) -> (CBlockItem) happyOut19 x = unsafeCoerce# x {-# INLINE happyOut19 #-} happyIn20 :: (CFunDef) -> (HappyAbsSyn ) happyIn20 x = unsafeCoerce# x {-# INLINE happyIn20 #-} happyOut20 :: (HappyAbsSyn ) -> (CFunDef) happyOut20 x = unsafeCoerce# x {-# INLINE happyOut20 #-} happyIn21 :: (Reversed [Ident]) -> (HappyAbsSyn ) happyIn21 x = unsafeCoerce# x {-# INLINE happyIn21 #-} happyOut21 :: (HappyAbsSyn ) -> (Reversed [Ident]) happyOut21 x = unsafeCoerce# x {-# INLINE happyOut21 #-} happyIn22 :: (CStat) -> (HappyAbsSyn ) happyIn22 x = unsafeCoerce# x {-# INLINE happyIn22 #-} happyOut22 :: (HappyAbsSyn ) -> (CStat) happyOut22 x = unsafeCoerce# x {-# INLINE happyOut22 #-} happyIn23 :: (CStat) -> (HappyAbsSyn ) happyIn23 x = unsafeCoerce# x {-# INLINE happyIn23 #-} happyOut23 :: (HappyAbsSyn ) -> (CStat) happyOut23 x = unsafeCoerce# x {-# INLINE happyOut23 #-} happyIn24 :: (CStat) -> (HappyAbsSyn ) happyIn24 x = unsafeCoerce# x {-# INLINE happyIn24 #-} happyOut24 :: (HappyAbsSyn ) -> (CStat) happyOut24 x = unsafeCoerce# x {-# INLINE happyOut24 #-} happyIn25 :: (CStat) -> (HappyAbsSyn ) happyIn25 x = unsafeCoerce# x {-# INLINE happyIn25 #-} happyOut25 :: (HappyAbsSyn ) -> (CStat) happyOut25 x = unsafeCoerce# x {-# INLINE happyOut25 #-} happyIn26 :: (CAsmStmt) -> (HappyAbsSyn ) happyIn26 x = unsafeCoerce# x {-# INLINE happyIn26 #-} happyOut26 :: (HappyAbsSyn ) -> (CAsmStmt) happyOut26 x = unsafeCoerce# x {-# INLINE happyOut26 #-} happyIn27 :: (Maybe CTypeQual) -> (HappyAbsSyn ) happyIn27 x = unsafeCoerce# x {-# INLINE happyIn27 #-} happyOut27 :: (HappyAbsSyn ) -> (Maybe CTypeQual) happyOut27 x = unsafeCoerce# x {-# INLINE happyOut27 #-} happyIn28 :: ([CAsmOperand]) -> (HappyAbsSyn ) happyIn28 x = unsafeCoerce# x {-# INLINE happyIn28 #-} happyOut28 :: (HappyAbsSyn ) -> ([CAsmOperand]) happyOut28 x = unsafeCoerce# x {-# INLINE happyOut28 #-} happyIn29 :: (Reversed [CAsmOperand]) -> (HappyAbsSyn ) happyIn29 x = unsafeCoerce# x {-# INLINE happyIn29 #-} happyOut29 :: (HappyAbsSyn ) -> (Reversed [CAsmOperand]) happyOut29 x = unsafeCoerce# x {-# INLINE happyOut29 #-} happyIn30 :: (CAsmOperand) -> (HappyAbsSyn ) happyIn30 x = unsafeCoerce# x {-# INLINE happyIn30 #-} happyOut30 :: (HappyAbsSyn ) -> (CAsmOperand) happyOut30 x = unsafeCoerce# x {-# INLINE happyOut30 #-} happyIn31 :: (Reversed [CStrLit]) -> (HappyAbsSyn ) happyIn31 x = unsafeCoerce# x {-# INLINE happyIn31 #-} happyOut31 :: (HappyAbsSyn ) -> (Reversed [CStrLit]) happyOut31 x = unsafeCoerce# x {-# INLINE happyOut31 #-} happyIn32 :: (CDecl) -> (HappyAbsSyn ) happyIn32 x = unsafeCoerce# x {-# INLINE happyIn32 #-} happyOut32 :: (HappyAbsSyn ) -> (CDecl) happyOut32 x = unsafeCoerce# x {-# INLINE happyOut32 #-} happyIn33 :: (Reversed [CDecl]) -> (HappyAbsSyn ) happyIn33 x = unsafeCoerce# x {-# INLINE happyIn33 #-} happyOut33 :: (HappyAbsSyn ) -> (Reversed [CDecl]) happyOut33 x = unsafeCoerce# x {-# INLINE happyOut33 #-} happyIn34 :: (CDecl) -> (HappyAbsSyn ) happyIn34 x = unsafeCoerce# x {-# INLINE happyIn34 #-} happyOut34 :: (HappyAbsSyn ) -> (CDecl) happyOut34 x = unsafeCoerce# x {-# INLINE happyOut34 #-} happyIn35 :: ((Maybe CStrLit, [CAttr])) -> (HappyAbsSyn ) happyIn35 x = unsafeCoerce# x {-# INLINE happyIn35 #-} happyOut35 :: (HappyAbsSyn ) -> ((Maybe CStrLit, [CAttr])) happyOut35 x = unsafeCoerce# x {-# INLINE happyOut35 #-} happyIn36 :: (CDecl) -> (HappyAbsSyn ) happyIn36 x = unsafeCoerce# x {-# INLINE happyIn36 #-} happyOut36 :: (HappyAbsSyn ) -> (CDecl) happyOut36 x = unsafeCoerce# x {-# INLINE happyOut36 #-} happyIn37 :: ([CDeclSpec]) -> (HappyAbsSyn ) happyIn37 x = unsafeCoerce# x {-# INLINE happyIn37 #-} happyOut37 :: (HappyAbsSyn ) -> ([CDeclSpec]) happyOut37 x = unsafeCoerce# x {-# INLINE happyOut37 #-} happyIn38 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) happyIn38 x = unsafeCoerce# x {-# INLINE happyIn38 #-} happyOut38 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) happyOut38 x = unsafeCoerce# x {-# INLINE happyOut38 #-} happyIn39 :: (CDeclSpec) -> (HappyAbsSyn ) happyIn39 x = unsafeCoerce# x {-# INLINE happyIn39 #-} happyOut39 :: (HappyAbsSyn ) -> (CDeclSpec) happyOut39 x = unsafeCoerce# x {-# INLINE happyOut39 #-} happyIn40 :: (CStorageSpec) -> (HappyAbsSyn ) happyIn40 x = unsafeCoerce# x {-# INLINE happyIn40 #-} happyOut40 :: (HappyAbsSyn ) -> (CStorageSpec) happyOut40 x = unsafeCoerce# x {-# INLINE happyOut40 #-} happyIn41 :: ([CDeclSpec]) -> (HappyAbsSyn ) happyIn41 x = unsafeCoerce# x {-# INLINE happyIn41 #-} happyOut41 :: (HappyAbsSyn ) -> ([CDeclSpec]) happyOut41 x = unsafeCoerce# x {-# INLINE happyOut41 #-} happyIn42 :: (CTypeSpec) -> (HappyAbsSyn ) happyIn42 x = unsafeCoerce# x {-# INLINE happyIn42 #-} happyOut42 :: (HappyAbsSyn ) -> (CTypeSpec) happyOut42 x = unsafeCoerce# x {-# INLINE happyOut42 #-} happyIn43 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) happyIn43 x = unsafeCoerce# x {-# INLINE happyIn43 #-} happyOut43 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) happyOut43 x = unsafeCoerce# x {-# INLINE happyOut43 #-} happyIn44 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) happyIn44 x = unsafeCoerce# x {-# INLINE happyIn44 #-} happyOut44 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) happyOut44 x = unsafeCoerce# x {-# INLINE happyOut44 #-} happyIn45 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) happyIn45 x = unsafeCoerce# x {-# INLINE happyIn45 #-} happyOut45 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) happyOut45 x = unsafeCoerce# x {-# INLINE happyOut45 #-} happyIn46 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) happyIn46 x = unsafeCoerce# x {-# INLINE happyIn46 #-} happyOut46 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) happyOut46 x = unsafeCoerce# x {-# INLINE happyOut46 #-} happyIn47 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) happyIn47 x = unsafeCoerce# x {-# INLINE happyIn47 #-} happyOut47 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) happyOut47 x = unsafeCoerce# x {-# INLINE happyOut47 #-} happyIn48 :: (Reversed [CDeclSpec]) -> (HappyAbsSyn ) happyIn48 x = unsafeCoerce# x {-# INLINE happyIn48 #-} happyOut48 :: (HappyAbsSyn ) -> (Reversed [CDeclSpec]) happyOut48 x = unsafeCoerce# x {-# INLINE happyOut48 #-} happyIn49 :: (CTypeSpec) -> (HappyAbsSyn ) happyIn49 x = unsafeCoerce# x {-# INLINE happyIn49 #-} happyOut49 :: (HappyAbsSyn ) -> (CTypeSpec) happyOut49 x = unsafeCoerce# x {-# INLINE happyOut49 #-} happyIn50 :: (CStructUnion) -> (HappyAbsSyn ) happyIn50 x = unsafeCoerce# x {-# INLINE happyIn50 #-} happyOut50 :: (HappyAbsSyn ) -> (CStructUnion) happyOut50 x = unsafeCoerce# x {-# INLINE happyOut50 #-} happyIn51 :: (Located CStructTag) -> (HappyAbsSyn ) happyIn51 x = unsafeCoerce# x {-# INLINE happyIn51 #-} happyOut51 :: (HappyAbsSyn ) -> (Located CStructTag) happyOut51 x = unsafeCoerce# x {-# INLINE happyOut51 #-} happyIn52 :: (Reversed [CDecl]) -> (HappyAbsSyn ) happyIn52 x = unsafeCoerce# x {-# INLINE happyIn52 #-} happyOut52 :: (HappyAbsSyn ) -> (Reversed [CDecl]) happyOut52 x = unsafeCoerce# x {-# INLINE happyOut52 #-} happyIn53 :: (CDecl) -> (HappyAbsSyn ) happyIn53 x = unsafeCoerce# x {-# INLINE happyIn53 #-} happyOut53 :: (HappyAbsSyn ) -> (CDecl) happyOut53 x = unsafeCoerce# x {-# INLINE happyOut53 #-} happyIn54 :: (CDecl) -> (HappyAbsSyn ) happyIn54 x = unsafeCoerce# x {-# INLINE happyIn54 #-} happyOut54 :: (HappyAbsSyn ) -> (CDecl) happyOut54 x = unsafeCoerce# x {-# INLINE happyOut54 #-} happyIn55 :: (CDecl) -> (HappyAbsSyn ) happyIn55 x = unsafeCoerce# x {-# INLINE happyIn55 #-} happyOut55 :: (HappyAbsSyn ) -> (CDecl) happyOut55 x = unsafeCoerce# x {-# INLINE happyOut55 #-} happyIn56 :: ((Maybe CDeclr, Maybe CExpr)) -> (HappyAbsSyn ) happyIn56 x = unsafeCoerce# x {-# INLINE happyIn56 #-} happyOut56 :: (HappyAbsSyn ) -> ((Maybe CDeclr, Maybe CExpr)) happyOut56 x = unsafeCoerce# x {-# INLINE happyOut56 #-} happyIn57 :: ((Maybe CDeclr, Maybe CExpr)) -> (HappyAbsSyn ) happyIn57 x = unsafeCoerce# x {-# INLINE happyIn57 #-} happyOut57 :: (HappyAbsSyn ) -> ((Maybe CDeclr, Maybe CExpr)) happyOut57 x = unsafeCoerce# x {-# INLINE happyOut57 #-} happyIn58 :: (CEnum) -> (HappyAbsSyn ) happyIn58 x = unsafeCoerce# x {-# INLINE happyIn58 #-} happyOut58 :: (HappyAbsSyn ) -> (CEnum) happyOut58 x = unsafeCoerce# x {-# INLINE happyOut58 #-} happyIn59 :: (Reversed [(Ident, Maybe CExpr)]) -> (HappyAbsSyn ) happyIn59 x = unsafeCoerce# x {-# INLINE happyIn59 #-} happyOut59 :: (HappyAbsSyn ) -> (Reversed [(Ident, Maybe CExpr)]) happyOut59 x = unsafeCoerce# x {-# INLINE happyOut59 #-} happyIn60 :: ((Ident, Maybe CExpr)) -> (HappyAbsSyn ) happyIn60 x = unsafeCoerce# x {-# INLINE happyIn60 #-} happyOut60 :: (HappyAbsSyn ) -> ((Ident, Maybe CExpr)) happyOut60 x = unsafeCoerce# x {-# INLINE happyOut60 #-} happyIn61 :: (CTypeQual) -> (HappyAbsSyn ) happyIn61 x = unsafeCoerce# x {-# INLINE happyIn61 #-} happyOut61 :: (HappyAbsSyn ) -> (CTypeQual) happyOut61 x = unsafeCoerce# x {-# INLINE happyOut61 #-} happyIn62 :: (Reversed [CTypeQual]) -> (HappyAbsSyn ) happyIn62 x = unsafeCoerce# x {-# INLINE happyIn62 #-} happyOut62 :: (HappyAbsSyn ) -> (Reversed [CTypeQual]) happyOut62 x = unsafeCoerce# x {-# INLINE happyOut62 #-} happyIn63 :: (CDeclrR) -> (HappyAbsSyn ) happyIn63 x = unsafeCoerce# x {-# INLINE happyIn63 #-} happyOut63 :: (HappyAbsSyn ) -> (CDeclrR) happyOut63 x = unsafeCoerce# x {-# INLINE happyOut63 #-} happyIn64 :: (Maybe CStrLit) -> (HappyAbsSyn ) happyIn64 x = unsafeCoerce# x {-# INLINE happyIn64 #-} happyOut64 :: (HappyAbsSyn ) -> (Maybe CStrLit) happyOut64 x = unsafeCoerce# x {-# INLINE happyOut64 #-} happyIn65 :: (CDeclrR) -> (HappyAbsSyn ) happyIn65 x = unsafeCoerce# x {-# INLINE happyIn65 #-} happyOut65 :: (HappyAbsSyn ) -> (CDeclrR) happyOut65 x = unsafeCoerce# x {-# INLINE happyOut65 #-} happyIn66 :: (CDeclrR) -> (HappyAbsSyn ) happyIn66 x = unsafeCoerce# x {-# INLINE happyIn66 #-} happyOut66 :: (HappyAbsSyn ) -> (CDeclrR) happyOut66 x = unsafeCoerce# x {-# INLINE happyOut66 #-} happyIn67 :: (CDeclrR) -> (HappyAbsSyn ) happyIn67 x = unsafeCoerce# x {-# INLINE happyIn67 #-} happyOut67 :: (HappyAbsSyn ) -> (CDeclrR) happyOut67 x = unsafeCoerce# x {-# INLINE happyOut67 #-} happyIn68 :: (CDeclrR) -> (HappyAbsSyn ) happyIn68 x = unsafeCoerce# x {-# INLINE happyIn68 #-} happyOut68 :: (HappyAbsSyn ) -> (CDeclrR) happyOut68 x = unsafeCoerce# x {-# INLINE happyOut68 #-} happyIn69 :: (CDeclrR) -> (HappyAbsSyn ) happyIn69 x = unsafeCoerce# x {-# INLINE happyIn69 #-} happyOut69 :: (HappyAbsSyn ) -> (CDeclrR) happyOut69 x = unsafeCoerce# x {-# INLINE happyOut69 #-} happyIn70 :: (CDeclrR) -> (HappyAbsSyn ) happyIn70 x = unsafeCoerce# x {-# INLINE happyIn70 #-} happyOut70 :: (HappyAbsSyn ) -> (CDeclrR) happyOut70 x = unsafeCoerce# x {-# INLINE happyOut70 #-} happyIn71 :: (CDeclrR) -> (HappyAbsSyn ) happyIn71 x = unsafeCoerce# x {-# INLINE happyIn71 #-} happyOut71 :: (HappyAbsSyn ) -> (CDeclrR) happyOut71 x = unsafeCoerce# x {-# INLINE happyOut71 #-} happyIn72 :: (CDeclrR) -> (HappyAbsSyn ) happyIn72 x = unsafeCoerce# x {-# INLINE happyIn72 #-} happyOut72 :: (HappyAbsSyn ) -> (CDeclrR) happyOut72 x = unsafeCoerce# x {-# INLINE happyOut72 #-} happyIn73 :: (CDeclrR) -> (HappyAbsSyn ) happyIn73 x = unsafeCoerce# x {-# INLINE happyIn73 #-} happyOut73 :: (HappyAbsSyn ) -> (CDeclrR) happyOut73 x = unsafeCoerce# x {-# INLINE happyOut73 #-} happyIn74 :: (CDeclrR) -> (HappyAbsSyn ) happyIn74 x = unsafeCoerce# x {-# INLINE happyIn74 #-} happyOut74 :: (HappyAbsSyn ) -> (CDeclrR) happyOut74 x = unsafeCoerce# x {-# INLINE happyOut74 #-} happyIn75 :: (CDeclrR) -> (HappyAbsSyn ) happyIn75 x = unsafeCoerce# x {-# INLINE happyIn75 #-} happyOut75 :: (HappyAbsSyn ) -> (CDeclrR) happyOut75 x = unsafeCoerce# x {-# INLINE happyOut75 #-} happyIn76 :: (CDeclr) -> (HappyAbsSyn ) happyIn76 x = unsafeCoerce# x {-# INLINE happyIn76 #-} happyOut76 :: (HappyAbsSyn ) -> (CDeclr) happyOut76 x = unsafeCoerce# x {-# INLINE happyOut76 #-} happyIn77 :: (CDeclrR) -> (HappyAbsSyn ) happyIn77 x = unsafeCoerce# x {-# INLINE happyIn77 #-} happyOut77 :: (HappyAbsSyn ) -> (CDeclrR) happyOut77 x = unsafeCoerce# x {-# INLINE happyOut77 #-} happyIn78 :: (CDeclrR) -> (HappyAbsSyn ) happyIn78 x = unsafeCoerce# x {-# INLINE happyIn78 #-} happyOut78 :: (HappyAbsSyn ) -> (CDeclrR) happyOut78 x = unsafeCoerce# x {-# INLINE happyOut78 #-} happyIn79 :: (([CDecl], Bool)) -> (HappyAbsSyn ) happyIn79 x = unsafeCoerce# x {-# INLINE happyIn79 #-} happyOut79 :: (HappyAbsSyn ) -> (([CDecl], Bool)) happyOut79 x = unsafeCoerce# x {-# INLINE happyOut79 #-} happyIn80 :: (Reversed [CDecl]) -> (HappyAbsSyn ) happyIn80 x = unsafeCoerce# x {-# INLINE happyIn80 #-} happyOut80 :: (HappyAbsSyn ) -> (Reversed [CDecl]) happyOut80 x = unsafeCoerce# x {-# INLINE happyOut80 #-} happyIn81 :: (CDecl) -> (HappyAbsSyn ) happyIn81 x = unsafeCoerce# x {-# INLINE happyIn81 #-} happyOut81 :: (HappyAbsSyn ) -> (CDecl) happyOut81 x = unsafeCoerce# x {-# INLINE happyOut81 #-} happyIn82 :: (Reversed [Ident]) -> (HappyAbsSyn ) happyIn82 x = unsafeCoerce# x {-# INLINE happyIn82 #-} happyOut82 :: (HappyAbsSyn ) -> (Reversed [Ident]) happyOut82 x = unsafeCoerce# x {-# INLINE happyOut82 #-} happyIn83 :: (CDecl) -> (HappyAbsSyn ) happyIn83 x = unsafeCoerce# x {-# INLINE happyIn83 #-} happyOut83 :: (HappyAbsSyn ) -> (CDecl) happyOut83 x = unsafeCoerce# x {-# INLINE happyOut83 #-} happyIn84 :: (CDeclrR) -> (HappyAbsSyn ) happyIn84 x = unsafeCoerce# x {-# INLINE happyIn84 #-} happyOut84 :: (HappyAbsSyn ) -> (CDeclrR) happyOut84 x = unsafeCoerce# x {-# INLINE happyOut84 #-} happyIn85 :: (CDeclrR -> CDeclrR) -> (HappyAbsSyn ) happyIn85 x = unsafeCoerce# x {-# INLINE happyIn85 #-} happyOut85 :: (HappyAbsSyn ) -> (CDeclrR -> CDeclrR) happyOut85 x = unsafeCoerce# x {-# INLINE happyOut85 #-} happyIn86 :: (CDeclrR -> CDeclrR) -> (HappyAbsSyn ) happyIn86 x = unsafeCoerce# x {-# INLINE happyIn86 #-} happyOut86 :: (HappyAbsSyn ) -> (CDeclrR -> CDeclrR) happyOut86 x = unsafeCoerce# x {-# INLINE happyOut86 #-} happyIn87 :: (CDeclrR -> CDeclrR) -> (HappyAbsSyn ) happyIn87 x = unsafeCoerce# x {-# INLINE happyIn87 #-} happyOut87 :: (HappyAbsSyn ) -> (CDeclrR -> CDeclrR) happyOut87 x = unsafeCoerce# x {-# INLINE happyOut87 #-} happyIn88 :: (CDeclrR) -> (HappyAbsSyn ) happyIn88 x = unsafeCoerce# x {-# INLINE happyIn88 #-} happyOut88 :: (HappyAbsSyn ) -> (CDeclrR) happyOut88 x = unsafeCoerce# x {-# INLINE happyOut88 #-} happyIn89 :: (CDeclrR) -> (HappyAbsSyn ) happyIn89 x = unsafeCoerce# x {-# INLINE happyIn89 #-} happyOut89 :: (HappyAbsSyn ) -> (CDeclrR) happyOut89 x = unsafeCoerce# x {-# INLINE happyOut89 #-} happyIn90 :: (CInit) -> (HappyAbsSyn ) happyIn90 x = unsafeCoerce# x {-# INLINE happyIn90 #-} happyOut90 :: (HappyAbsSyn ) -> (CInit) happyOut90 x = unsafeCoerce# x {-# INLINE happyOut90 #-} happyIn91 :: (Maybe CInit) -> (HappyAbsSyn ) happyIn91 x = unsafeCoerce# x {-# INLINE happyIn91 #-} happyOut91 :: (HappyAbsSyn ) -> (Maybe CInit) happyOut91 x = unsafeCoerce# x {-# INLINE happyOut91 #-} happyIn92 :: (Reversed CInitList) -> (HappyAbsSyn ) happyIn92 x = unsafeCoerce# x {-# INLINE happyIn92 #-} happyOut92 :: (HappyAbsSyn ) -> (Reversed CInitList) happyOut92 x = unsafeCoerce# x {-# INLINE happyOut92 #-} happyIn93 :: ([CDesignator]) -> (HappyAbsSyn ) happyIn93 x = unsafeCoerce# x {-# INLINE happyIn93 #-} happyOut93 :: (HappyAbsSyn ) -> ([CDesignator]) happyOut93 x = unsafeCoerce# x {-# INLINE happyOut93 #-} happyIn94 :: (Reversed [CDesignator]) -> (HappyAbsSyn ) happyIn94 x = unsafeCoerce# x {-# INLINE happyIn94 #-} happyOut94 :: (HappyAbsSyn ) -> (Reversed [CDesignator]) happyOut94 x = unsafeCoerce# x {-# INLINE happyOut94 #-} happyIn95 :: (CDesignator) -> (HappyAbsSyn ) happyIn95 x = unsafeCoerce# x {-# INLINE happyIn95 #-} happyOut95 :: (HappyAbsSyn ) -> (CDesignator) happyOut95 x = unsafeCoerce# x {-# INLINE happyOut95 #-} happyIn96 :: (CDesignator) -> (HappyAbsSyn ) happyIn96 x = unsafeCoerce# x {-# INLINE happyIn96 #-} happyOut96 :: (HappyAbsSyn ) -> (CDesignator) happyOut96 x = unsafeCoerce# x {-# INLINE happyOut96 #-} happyIn97 :: (CExpr) -> (HappyAbsSyn ) happyIn97 x = unsafeCoerce# x {-# INLINE happyIn97 #-} happyOut97 :: (HappyAbsSyn ) -> (CExpr) happyOut97 x = unsafeCoerce# x {-# INLINE happyOut97 #-} happyIn98 :: (Reversed [CDesignator]) -> (HappyAbsSyn ) happyIn98 x = unsafeCoerce# x {-# INLINE happyIn98 #-} happyOut98 :: (HappyAbsSyn ) -> (Reversed [CDesignator]) happyOut98 x = unsafeCoerce# x {-# INLINE happyOut98 #-} happyIn99 :: (CExpr) -> (HappyAbsSyn ) happyIn99 x = unsafeCoerce# x {-# INLINE happyIn99 #-} happyOut99 :: (HappyAbsSyn ) -> (CExpr) happyOut99 x = unsafeCoerce# x {-# INLINE happyOut99 #-} happyIn100 :: (Reversed [CExpr]) -> (HappyAbsSyn ) happyIn100 x = unsafeCoerce# x {-# INLINE happyIn100 #-} happyOut100 :: (HappyAbsSyn ) -> (Reversed [CExpr]) happyOut100 x = unsafeCoerce# x {-# INLINE happyOut100 #-} happyIn101 :: (CExpr) -> (HappyAbsSyn ) happyIn101 x = unsafeCoerce# x {-# INLINE happyIn101 #-} happyOut101 :: (HappyAbsSyn ) -> (CExpr) happyOut101 x = unsafeCoerce# x {-# INLINE happyOut101 #-} happyIn102 :: (Located CUnaryOp) -> (HappyAbsSyn ) happyIn102 x = unsafeCoerce# x {-# INLINE happyIn102 #-} happyOut102 :: (HappyAbsSyn ) -> (Located CUnaryOp) happyOut102 x = unsafeCoerce# x {-# INLINE happyOut102 #-} happyIn103 :: (CExpr) -> (HappyAbsSyn ) happyIn103 x = unsafeCoerce# x {-# INLINE happyIn103 #-} happyOut103 :: (HappyAbsSyn ) -> (CExpr) happyOut103 x = unsafeCoerce# x {-# INLINE happyOut103 #-} happyIn104 :: (CExpr) -> (HappyAbsSyn ) happyIn104 x = unsafeCoerce# x {-# INLINE happyIn104 #-} happyOut104 :: (HappyAbsSyn ) -> (CExpr) happyOut104 x = unsafeCoerce# x {-# INLINE happyOut104 #-} happyIn105 :: (CExpr) -> (HappyAbsSyn ) happyIn105 x = unsafeCoerce# x {-# INLINE happyIn105 #-} happyOut105 :: (HappyAbsSyn ) -> (CExpr) happyOut105 x = unsafeCoerce# x {-# INLINE happyOut105 #-} happyIn106 :: (CExpr) -> (HappyAbsSyn ) happyIn106 x = unsafeCoerce# x {-# INLINE happyIn106 #-} happyOut106 :: (HappyAbsSyn ) -> (CExpr) happyOut106 x = unsafeCoerce# x {-# INLINE happyOut106 #-} happyIn107 :: (CExpr) -> (HappyAbsSyn ) happyIn107 x = unsafeCoerce# x {-# INLINE happyIn107 #-} happyOut107 :: (HappyAbsSyn ) -> (CExpr) happyOut107 x = unsafeCoerce# x {-# INLINE happyOut107 #-} happyIn108 :: (CExpr) -> (HappyAbsSyn ) happyIn108 x = unsafeCoerce# x {-# INLINE happyIn108 #-} happyOut108 :: (HappyAbsSyn ) -> (CExpr) happyOut108 x = unsafeCoerce# x {-# INLINE happyOut108 #-} happyIn109 :: (CExpr) -> (HappyAbsSyn ) happyIn109 x = unsafeCoerce# x {-# INLINE happyIn109 #-} happyOut109 :: (HappyAbsSyn ) -> (CExpr) happyOut109 x = unsafeCoerce# x {-# INLINE happyOut109 #-} happyIn110 :: (CExpr) -> (HappyAbsSyn ) happyIn110 x = unsafeCoerce# x {-# INLINE happyIn110 #-} happyOut110 :: (HappyAbsSyn ) -> (CExpr) happyOut110 x = unsafeCoerce# x {-# INLINE happyOut110 #-} happyIn111 :: (CExpr) -> (HappyAbsSyn ) happyIn111 x = unsafeCoerce# x {-# INLINE happyIn111 #-} happyOut111 :: (HappyAbsSyn ) -> (CExpr) happyOut111 x = unsafeCoerce# x {-# INLINE happyOut111 #-} happyIn112 :: (CExpr) -> (HappyAbsSyn ) happyIn112 x = unsafeCoerce# x {-# INLINE happyIn112 #-} happyOut112 :: (HappyAbsSyn ) -> (CExpr) happyOut112 x = unsafeCoerce# x {-# INLINE happyOut112 #-} happyIn113 :: (CExpr) -> (HappyAbsSyn ) happyIn113 x = unsafeCoerce# x {-# INLINE happyIn113 #-} happyOut113 :: (HappyAbsSyn ) -> (CExpr) happyOut113 x = unsafeCoerce# x {-# INLINE happyOut113 #-} happyIn114 :: (CExpr) -> (HappyAbsSyn ) happyIn114 x = unsafeCoerce# x {-# INLINE happyIn114 #-} happyOut114 :: (HappyAbsSyn ) -> (CExpr) happyOut114 x = unsafeCoerce# x {-# INLINE happyOut114 #-} happyIn115 :: (CExpr) -> (HappyAbsSyn ) happyIn115 x = unsafeCoerce# x {-# INLINE happyIn115 #-} happyOut115 :: (HappyAbsSyn ) -> (CExpr) happyOut115 x = unsafeCoerce# x {-# INLINE happyOut115 #-} happyIn116 :: (Located CAssignOp) -> (HappyAbsSyn ) happyIn116 x = unsafeCoerce# x {-# INLINE happyIn116 #-} happyOut116 :: (HappyAbsSyn ) -> (Located CAssignOp) happyOut116 x = unsafeCoerce# x {-# INLINE happyOut116 #-} happyIn117 :: (CExpr) -> (HappyAbsSyn ) happyIn117 x = unsafeCoerce# x {-# INLINE happyIn117 #-} happyOut117 :: (HappyAbsSyn ) -> (CExpr) happyOut117 x = unsafeCoerce# x {-# INLINE happyOut117 #-} happyIn118 :: (Reversed [CExpr]) -> (HappyAbsSyn ) happyIn118 x = unsafeCoerce# x {-# INLINE happyIn118 #-} happyOut118 :: (HappyAbsSyn ) -> (Reversed [CExpr]) happyOut118 x = unsafeCoerce# x {-# INLINE happyOut118 #-} happyIn119 :: (Maybe CExpr) -> (HappyAbsSyn ) happyIn119 x = unsafeCoerce# x {-# INLINE happyIn119 #-} happyOut119 :: (HappyAbsSyn ) -> (Maybe CExpr) happyOut119 x = unsafeCoerce# x {-# INLINE happyOut119 #-} happyIn120 :: (Maybe CExpr) -> (HappyAbsSyn ) happyIn120 x = unsafeCoerce# x {-# INLINE happyIn120 #-} happyOut120 :: (HappyAbsSyn ) -> (Maybe CExpr) happyOut120 x = unsafeCoerce# x {-# INLINE happyOut120 #-} happyIn121 :: (CExpr) -> (HappyAbsSyn ) happyIn121 x = unsafeCoerce# x {-# INLINE happyIn121 #-} happyOut121 :: (HappyAbsSyn ) -> (CExpr) happyOut121 x = unsafeCoerce# x {-# INLINE happyOut121 #-} happyIn122 :: (CConst) -> (HappyAbsSyn ) happyIn122 x = unsafeCoerce# x {-# INLINE happyIn122 #-} happyOut122 :: (HappyAbsSyn ) -> (CConst) happyOut122 x = unsafeCoerce# x {-# INLINE happyOut122 #-} happyIn123 :: (CStrLit) -> (HappyAbsSyn ) happyIn123 x = unsafeCoerce# x {-# INLINE happyIn123 #-} happyOut123 :: (HappyAbsSyn ) -> (CStrLit) happyOut123 x = unsafeCoerce# x {-# INLINE happyOut123 #-} happyIn124 :: (Reversed [CString]) -> (HappyAbsSyn ) happyIn124 x = unsafeCoerce# x {-# INLINE happyIn124 #-} happyOut124 :: (HappyAbsSyn ) -> (Reversed [CString]) happyOut124 x = unsafeCoerce# x {-# INLINE happyOut124 #-} happyIn125 :: (Ident) -> (HappyAbsSyn ) happyIn125 x = unsafeCoerce# x {-# INLINE happyIn125 #-} happyOut125 :: (HappyAbsSyn ) -> (Ident) happyOut125 x = unsafeCoerce# x {-# INLINE happyOut125 #-} happyIn126 :: ([CAttr]) -> (HappyAbsSyn ) happyIn126 x = unsafeCoerce# x {-# INLINE happyIn126 #-} happyOut126 :: (HappyAbsSyn ) -> ([CAttr]) happyOut126 x = unsafeCoerce# x {-# INLINE happyOut126 #-} happyIn127 :: ([CAttr]) -> (HappyAbsSyn ) happyIn127 x = unsafeCoerce# x {-# INLINE happyIn127 #-} happyOut127 :: (HappyAbsSyn ) -> ([CAttr]) happyOut127 x = unsafeCoerce# x {-# INLINE happyOut127 #-} happyIn128 :: ([CAttr]) -> (HappyAbsSyn ) happyIn128 x = unsafeCoerce# x {-# INLINE happyIn128 #-} happyOut128 :: (HappyAbsSyn ) -> ([CAttr]) happyOut128 x = unsafeCoerce# x {-# INLINE happyOut128 #-} happyIn129 :: (Reversed [CAttr]) -> (HappyAbsSyn ) happyIn129 x = unsafeCoerce# x {-# INLINE happyIn129 #-} happyOut129 :: (HappyAbsSyn ) -> (Reversed [CAttr]) happyOut129 x = unsafeCoerce# x {-# INLINE happyOut129 #-} happyIn130 :: (Maybe CAttr) -> (HappyAbsSyn ) happyIn130 x = unsafeCoerce# x {-# INLINE happyIn130 #-} happyOut130 :: (HappyAbsSyn ) -> (Maybe CAttr) happyOut130 x = unsafeCoerce# x {-# INLINE happyOut130 #-} happyIn131 :: (Reversed [CExpr]) -> (HappyAbsSyn ) happyIn131 x = unsafeCoerce# x {-# INLINE happyIn131 #-} happyOut131 :: (HappyAbsSyn ) -> (Reversed [CExpr]) happyOut131 x = unsafeCoerce# x {-# INLINE happyOut131 #-} happyInTok :: CToken -> (HappyAbsSyn ) happyInTok x = unsafeCoerce# x {-# INLINE happyInTok #-} happyOutTok :: (HappyAbsSyn ) -> CToken happyOutTok x = unsafeCoerce# x {-# INLINE happyOutTok #-} happyActOffsets :: HappyAddr happyActOffsets = HappyA# "\x00\x00\x1d\x0f\xd3\x09\x31\x0f\x00\x00\x80\x07\x00\x00\x7f\x09\x77\x0f\x31\x0f\x00\x00\xc8\x09\x1f\x05\x05\x05\x7f\x03\xf0\x04\x65\x08\x54\x08\x49\x08\x3e\x08\xc6\x04\x00\x00\x2b\x08\xef\x07\x00\x00\x00\x00\x0b\x09\x00\x00\x00\x00\xcd\x0e\xcd\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x82\x04\xaf\x0e\x96\x0e\x00\x00\x00\x00\x00\x00\xf6\x07\x00\x00\x32\x0e\x14\x0e\x14\x0e\x48\x08\x47\x08\x24\x08\xb6\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\x07\xe6\x07\x00\x00\x00\x00\x4a\x05\xd2\x07\xfb\x0d\xd0\x07\xd6\x07\xd3\x09\xf5\x07\x24\x00\xed\x07\xfb\x0d\xec\x07\xd5\x07\xc6\x07\x00\x00\x76\x07\x00\x00\xae\x07\x00\x00\x95\x04\x8e\x04\x01\x01\xd5\x11\x00\x00\x01\x01\x00\x00\x9a\x19\x9a\x19\x11\x18\x01\x18\x21\x08\x21\x08\x00\x00\x00\x00\x71\x07\x00\x00\xa6\x11\x00\x00\x00\x00\x00\x00\xd9\x01\x00\x00\x00\x00\x00\x00\x4a\x05\x89\x12\x00\x00\x3d\x01\x3d\x01\xcb\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x07\x1d\x0f\x55\x07\x00\x00\xb8\x07\x6f\x09\x7a\x01\x59\x07\x5b\x07\xb3\x12\x00\x00\x00\x00\x4b\x00\xb2\x07\xb4\x09\xaa\x07\x4b\x00\x86\x07\x00\x00\x00\x00\x00\x00\xed\x01\x00\x00\x00\x00\xa7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x00\x00\x9d\x07\x00\x00\x94\x18\xff\x0a\x72\x07\x00\x00\x00\x00\x00\x00\x00\x00\xed\x01\x00\x00\x77\x11\x97\x07\x00\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x07\x5f\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x07\x00\x00\x6e\x02\x48\x02\x0f\x00\x52\x07\x00\x00\x00\x00\x00\x00\xed\x01\x00\x00\x00\x00\x7b\x07\x00\x00\x4f\x07\x53\x07\x00\x00\x1b\x07\x00\x00\x1b\x07\x00\x00\x00\x00\xfb\x0d\xfb\x0d\x00\x00\x4d\x07\xfb\x0d\x41\x07\xfb\x0d\x00\x00\x43\x08\x14\x07\xd3\x09\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x65\x07\x00\x00\x2e\x07\xf4\x06\x00\x00\xc3\x1a\xc3\x1a\xfb\x0d\x00\x00\x0b\x09\x00\x00\x00\x00\xf0\x06\x00\x00\x00\x00\x0b\x09\x00\x00\x0b\x09\x00\x00\x00\x00\x00\x00\x4e\x07\x97\x03\xe7\x1a\xab\x04\xab\x04\x7a\x0a\x4c\x07\x4b\x07\x9f\x1a\xfb\x0d\xfb\x0d\x97\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\xfb\x0d\x00\x00\xfb\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x0d\xfb\x0d\x36\x04\x36\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x07\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x09\xa3\x09\x8a\x04\x8a\x04\x4f\x04\x4f\x04\x4f\x04\x4f\x04\x7f\x03\x7f\x03\x1d\x04\x35\x07\x2b\x07\x16\x07\x0c\x07\xfb\x0d\x25\x07\x00\x00\xfb\x06\x00\x00\x61\x0d\x00\x00\x00\x00\x00\x00\xb7\x06\x57\x1a\x33\x1a\x48\x11\x00\x0f\x00\x00\x00\x00\x0f\x07\x0e\x07\x00\x00\xf3\x06\xdd\x06\xdb\x06\xc7\x06\xd3\x09\xdf\x07\xad\x06\x94\x06\x7c\x06\xd3\x09\xfb\x0d\x00\x00\xcb\x06\x6c\x19\xab\x06\xa7\x06\x00\x00\xc4\x06\x00\x00\xc3\x06\xc1\x06\xea\x00\xd8\x00\x38\x18\xa1\x06\x5d\x06\xaa\x06\x00\x00\x6f\x09\x38\x18\x86\x06\x00\x00\x00\x00\x1e\x19\x5b\x0b\x00\x00\x00\x00\xb1\x01\x93\x01\x8e\x06\x88\x06\x0f\x00\x47\x00\x93\x01\x00\x00\x38\x18\x66\x06\x00\x00\x49\x06\x00\x00\x6f\x09\x3e\x06\x00\x00\x00\x00\x00\x00\x00\x00\xed\x01\x00\x00\x62\x06\x00\x00\x38\x18\x3d\x06\x00\x00\x9b\x0a\x00\x00\x29\x06\xe0\x0b\x09\x00\xce\x05\x74\x02\xff\x0f\x74\x02\x21\x08\x21\x08\xd0\x0f\x24\x06\xfb\x05\x00\x00\x1b\x01\x45\x19\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x00\x19\x11\xd8\x00\xea\x10\x5a\x12\x6f\x09\x38\x18\x04\x06\x00\x00\x19\x06\x9e\x09\x12\x00\x12\x00\x0f\x00\x00\x00\x0f\x00\x00\x00\x0f\x00\x00\x00\x00\x00\xdc\x0c\x09\x06\xf4\x05\xcc\x03\x03\x06\xfe\x05\x77\x00\xca\x00\x00\x00\x00\x00\xef\x05\x00\x00\x00\x00\xcd\x02\x00\x00\xcb\x05\xcc\x03\xaa\x05\x00\x00\x00\x00\x00\x00\xdc\x0c\x4b\x09\x00\x00\x0f\x00\x00\x00\xfd\x0c\x00\x00\xc8\x05\xc1\x05\x8c\x05\x8c\x05\xbb\x10\x00\x00\xf1\x00\xc9\x00\x8c\x05\x00\x00\x56\x05\x66\x18\x00\x00\x53\x05\x00\x00\xf0\x18\xc2\x18\xa1\x0f\xde\x12\x53\x05\x53\x05\x00\x00\x72\x0f\x49\x07\x53\x05\x00\x00\x53\x05\x53\x05\x00\x00\xab\x04\x62\x0c\x9d\x05\x9b\x05\x09\x00\x00\x00\x90\x05\x46\x05\x37\x0a\x09\x00\x00\x00\x00\x00\x6f\x09\x38\x18\x6d\x05\x00\x00\x8f\x05\x8d\x05\xdc\x17\x00\x00\x00\x00\x00\x00\x2f\x09\x84\x05\x0e\x00\xbe\x00\x83\x05\x0f\x00\x0f\x00\x2c\x09\x00\x00\x00\x00\x00\x00\xe3\x0a\x65\x00\x00\x00\x00\x00\x81\x05\x79\x05\x10\x05\x00\x00\x00\x00\x00\x00\x35\x05\x35\x05\xd3\x09\xd3\x09\xd3\x09\x00\x00\xfb\x0d\xfb\x0d\xfb\x0d\x42\x05\x00\x00\xaa\x01\xc9\x03\xdf\x07\xf2\x04\x00\x00\x23\x05\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x00\x8c\x10\xd8\x00\x5d\x10\x2d\x05\xa7\x08\x00\x00\x7b\x1a\x9a\x03\x7b\x1a\x1c\x05\x1c\x05\x1c\x05\x30\x0c\x00\x00\xa2\x09\x31\x05\x2f\x05\x2d\x00\x33\x12\x00\x00\x00\x00\xfe\x0b\xfb\x0d\x00\x00\xfb\x0d\x00\x00\xfb\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x02\xfd\x0c\xdc\x02\x00\x00\x99\x01\x00\x00\xd4\x04\xfb\x0d\x9a\x03\xfe\x0b\x21\x05\x0d\x05\x13\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x04\x09\x05\xed\x02\x00\x00\xf9\x04\x00\x00\xc0\x04\x2e\x10\xc0\x04\xc0\x04\xc0\x04\x00\x00\xa3\x03\x89\x04\x00\x00\xa2\x04\x2a\x00\xd3\x09\xc7\x04\x9c\x04\x97\x04\x7f\x04\x00\x00\x00\x00\x88\x04\x88\x04\xa1\x04\x00\x00\x00\x00\x22\x09\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x0a\x0f\x00\x00\x00\xaf\x17\xd4\x02\x00\x00\xa0\x03\x98\x03\x0f\x1a\xc2\x12\x00\x00\x00\x00\xbe\x19\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x04\x9a\x04\x8b\x04\x86\x04\x09\x00\x0a\x04\x00\x00\x7a\x04\x00\x00\x00\x00\x68\x04\xfb\x0d\x00\x00\x00\x00\x00\x00\xb4\x04\x9f\x00\x04\x12\x00\x00\x00\x00\xdc\x0a\x3e\x09\x24\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x01\x2b\x00\x2b\x00\x16\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x02\xfb\x0d\xf4\x00\x00\x00\xe4\x0c\x64\x04\x77\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\x00\x00\x00\x2b\x00\x5f\x01\xcd\x00\x3e\x04\x00\x00\x00\x00\xfb\x0d\x3c\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x03\x1b\x04\xfb\x0d\x9e\x00\xeb\x19\xc8\x03\x00\x00\xc8\x03\x00\x00\xc8\x03\x06\x04\xfb\x0d\x00\x00\x00\x00\xcd\x00\x1f\x09\x00\x00\x00\x00\x00\x00\x00\x00\xd3\x09\xfb\x0d\xfb\x0d\xf5\x03\x00\x00\x0a\x01\xef\x03\x00\x00\x1a\x04\x49\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x03\x00\x00\x00\x00\x00\x00\xfb\x0d\x40\x03\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x97\x01\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x0b\x00\x00\x00\x00\x80\x0c\x00\x00\x00\x00\xfb\x0d\x63\x0b\x00\x00\x00\x00\x00\x00\x03\x04\x00\x00\x01\x04\xe1\x03\xfb\x0d\x2a\x00\xb6\x03\x2a\x00\x00\x00\xd8\x03\xd3\x03\x00\x00\x00\x00\x00\x00\xfb\x0d\x00\x00\x9e\x00\xd4\x02\x6a\x03\x00\x00\xfb\x0d\x00\x00\x00\x00\xb9\x03\x00\x00\x00\x00\x00\x00\xfb\x0d\x00\x00\x00\x00\x00\x00\x4a\x03\x4a\x03\x00\x00\xd3\x09\xd3\x09\xd5\x00\x00\x00\x00\x00\xa8\x03\x3b\x03\x3b\x03\x00\x00\x00\x00\x7a\x03\x00\x00\x00\x00\x74\x03\x72\x03\x00\x00\x46\x03\x0b\x03\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\xfb\x0d\xfb\x0d\x6c\x03\x5b\x03\x17\x03\xe9\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyGotoOffsets :: HappyAddr happyGotoOffsets = HappyA# "\x36\x03\x71\x00\xd3\x06\xc6\x1d\x3c\x03\x38\x00\x00\x00\x00\x00\xc5\x02\x35\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x03\x00\x00\x00\x00\x71\x0d\xa4\x0b\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x02\xd5\x0a\xb9\x0a\x00\x00\x00\x00\x00\x00\xa7\x02\x00\x00\x20\x0c\xbe\x03\x60\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x1a\x00\x00\x00\x76\x1f\x00\x00\x00\x00\xb8\x06\x00\x00\x95\x02\x00\x00\x4c\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x03\x00\x00\x00\x00\x00\x00\x2a\x06\xc3\x00\x00\x00\x8a\x05\x00\x00\x14\x00\x16\x01\x6c\x02\x7d\x01\xa2\x01\xcb\x00\x00\x00\x00\x00\x96\x08\x00\x00\x9a\x00\x00\x00\x00\x00\x00\x00\x99\x08\xe2\x02\x00\x00\x00\x00\xbb\x02\x15\x01\x00\x00\xa8\x0a\xd7\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\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\xff\xff\x00\x00\x00\x00\x00\x00\xca\x15\x71\x02\x5d\x02\x6a\x02\x77\x08\x00\x00\x00\x00\x70\x02\x00\x00\x5b\x08\x00\x00\x40\x00\xc6\x02\x00\x00\x00\x00\x00\x00\x52\x02\x9e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x04\x00\x00\x66\x02\x00\x00\xa8\x13\x16\x17\xa9\x02\x00\x00\x00\x00\x00\x00\x00\x00\x51\x02\x90\x02\xec\x00\x00\x00\x00\x00\x1a\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x02\x4f\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x02\x9a\x13\xe8\x16\x35\x08\x75\x02\x00\x00\x00\x00\x00\x00\x4a\x02\x5c\x02\x00\x00\x00\x00\x00\x00\x62\x02\x31\x02\x56\x02\xf3\x07\x00\x00\xee\x07\x00\x00\x00\x00\xab\x1d\x90\x1d\x00\x00\x00\x00\x75\x1d\x00\x00\x5a\x1d\x00\x00\x98\x06\x00\x00\x4e\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x01\xe9\x07\x00\x00\x7b\x16\x53\x16\x5b\x1f\x00\x00\xe7\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x02\x00\x00\x5b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x69\x05\x9b\x00\x78\x00\x50\x00\x89\x16\x00\x00\x00\x00\xac\x03\x3f\x1d\xc7\x1f\x24\x1d\xe2\x1f\x08\x15\x84\x15\xfd\x1f\xf1\x0b\x6f\x0b\xf0\x0c\xbb\x0c\x40\x0c\x3a\x0b\x9b\x0c\x1a\x0b\xfc\x07\x26\x07\xc1\x0b\x2c\x0a\x9d\x09\x00\x00\x40\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x1d\xee\x1c\xdb\x01\xcd\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\xac\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x99\x07\x00\x00\x00\x00\x00\x00\xc6\x01\x61\x04\x00\x00\x73\x13\xda\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x06\x35\x02\x33\x02\xea\x01\x7e\x01\x18\x06\x25\x1f\x00\x00\x00\x00\xa6\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x03\x91\x20\x87\x04\xdd\x01\xce\x07\x00\x00\x00\x00\xa6\x15\x4c\x04\xb7\x01\x00\x00\x00\x00\xda\x13\x26\x03\x00\x00\x00\x00\x6c\x05\x30\x13\x00\x00\x00\x00\xa2\x07\x36\x02\xb6\x0b\x00\x00\x26\x04\xa0\x01\x00\x00\x00\x00\xa7\x01\x4e\x15\xc7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x02\xb0\x01\x00\x00\x00\x00\xeb\x03\x60\x01\x00\x00\xa9\x16\x00\x00\x00\x00\xc4\x1b\x6a\x07\x14\x01\x40\x20\x18\x14\x28\x20\x9f\x01\x18\x00\x2c\x14\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x03\x00\x00\x00\x00\x00\x00\x00\x00\x84\x20\x47\x07\x77\x20\x68\x14\xaf\x14\x2a\x15\xc5\x03\x4d\x01\x00\x00\x00\x00\x73\x07\xd3\x01\xeb\x04\x27\x07\x00\x00\x20\x07\x00\x00\x15\x07\x00\x00\x00\x00\xbf\x03\x00\x00\x00\x00\xb9\x01\x00\x00\x00\x00\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x01\x00\x00\x00\x00\x00\x00\x00\x00\x44\x04\x15\x07\x00\x00\xd9\x06\x00\x00\xa9\x1b\x00\x00\x00\x00\x00\x00\x16\x02\xf7\x01\xa9\x14\x00\x00\x6f\x13\x0d\x0e\xf4\x01\x00\x00\x00\x00\x0a\x14\x00\x00\x96\x06\x00\x00\x00\x04\x00\x00\x3e\x13\x60\x17\x76\x06\x68\x06\x00\x00\x06\x13\x59\x17\x2b\x06\x00\x00\x10\x06\xe2\x05\x00\x00\xdb\x00\x62\x17\x00\x00\x00\x00\xdf\x05\x00\x00\x00\x00\x00\x00\xe0\x16\xd9\x05\x00\x00\x00\x00\xd2\x14\x64\x03\x42\x01\x00\x00\x00\x00\x00\x00\x31\x16\x5c\x01\x00\x00\x00\x00\xff\x05\x00\x00\xf9\x08\x60\x07\x00\x00\xf1\x05\xe4\x05\xe1\x05\x00\x00\x00\x00\x00\x00\x92\x0c\x18\x04\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x01\x00\x00\x00\x00\x00\x00\x5e\x01\x57\x01\xae\x05\x93\x05\x78\x05\x00\x00\x31\x1c\x16\x1c\xd3\x1c\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x01\x33\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x09\x43\x01\xc4\x07\x3e\x01\x00\x00\x36\x07\x00\x00\x40\x16\xd5\xff\xe1\x14\x00\x00\x00\x00\x00\x00\xc7\x02\x00\x00\x8a\x02\x00\x00\x00\x00\xf9\x00\x96\x14\x00\x00\x00\x00\x13\x1b\x0a\x1f\x00\x00\x91\x1f\x00\x00\xef\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x1b\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x1e\xd3\x00\xf1\x1a\x00\x00\x00\x00\x7f\x00\x00\x00\xb4\x05\x00\x00\x00\x00\x00\x00\x00\x00\xce\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x01\x67\x01\x36\x01\x1d\x01\x17\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xff\x0e\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x80\x00\x00\x00\x00\x00\x00\x00\x99\x05\x00\x00\x00\x00\x6b\x0e\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x09\x5c\x05\x00\x00\x31\x16\x6a\x20\x00\x00\x00\x00\x00\x00\x04\x04\xb9\x16\x00\x00\x00\x00\x22\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x04\xb0\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x1e\x00\x00\x00\x00\x00\x00\x1a\x17\xfa\x05\x64\x14\x00\x00\x00\x00\x80\x16\x9a\x06\xca\x04\x00\x00\x00\x00\x00\x00\x00\x00\xc3\x02\xaa\x0d\x36\x0d\xfa\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x1e\xd9\xff\x00\x00\x50\x1b\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\x00\x00\x91\x06\xbf\x03\x5a\x05\x00\x00\x00\x00\x00\x00\x83\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x68\x1e\x57\x04\x61\x04\x78\x04\x00\x00\x09\x04\x00\x00\x86\x03\x00\x00\x4d\x1e\x00\x00\x00\x00\x5a\x05\xab\x03\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x04\xfb\x1b\xe0\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\xb8\x1c\x44\x00\x00\x00\x00\x00\x00\x00\x2c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x1b\x00\x00\x00\x00\x73\x1b\x00\x00\x00\x00\x32\x1e\x35\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x1c\xf5\xff\x00\x00\xf1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x1e\x00\x00\x5f\x03\x5b\x20\xd0\xff\x00\x00\xfc\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x1d\x00\x00\x00\x00\x00\x00\xec\x01\xd0\xff\x00\x00\xd6\x04\x9e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x32\x00\xa5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\xff\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x1c\x67\x1c\x00\x00\x00\x00\x00\x00\x91\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyDefActions :: HappyAddr happyDefActions = HappyA# "\xfa\xff\x3d\xfe\x00\x00\x00\x00\x00\x00\x3d\xfe\x9b\xfe\x8f\xfe\x7d\xfe\x00\x00\x7b\xfe\x77\xfe\x74\xfe\x71\xfe\x6c\xfe\x69\xfe\x67\xfe\x65\xfe\x63\xfe\x61\xfe\x5f\xfe\x5c\xfe\x4f\xfe\x00\x00\xa5\xfe\xa4\xfe\x3d\xfe\x7e\xfe\x7f\xfe\x00\x00\x00\x00\x81\xfe\x80\xfe\x82\xfe\x83\xfe\x00\x00\x00\x00\x00\x00\x45\xfe\x46\xfe\x44\xfe\x43\xfe\xa6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\xff\xe3\xff\xe2\xff\xe1\xff\xe0\xff\xdf\xff\xde\xff\x00\x00\x00\x00\xc7\xff\xd7\xff\xb5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\xfe\x00\x00\x00\x00\xa6\xfe\x3e\xfe\x00\x00\xf7\xff\x00\x00\xf6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x98\xff\x00\x00\x77\xff\x9b\xff\x8a\xff\x9a\xff\x89\xff\x99\xff\x88\xff\x6c\xff\x52\xff\x3d\xfe\x51\xff\x00\x00\xe5\xff\x0a\xff\x08\xff\x09\xff\xa6\xff\xfb\xfe\xfa\xfe\x00\x00\x3c\xfe\x3b\xfe\x00\x00\x3d\xfe\x00\x00\x8d\xff\x7e\xff\x86\xff\x7d\xff\x81\xff\x3d\xfe\x8f\xff\x82\xff\x84\xff\x83\xff\x8c\xff\x85\xff\x80\xff\x8e\xff\x4d\xff\x90\xff\x00\x00\x8b\xff\x4c\xff\x7f\xff\x87\xff\xfe\xfe\x60\xff\x00\x00\x3d\xfe\x00\x00\xf5\xff\x00\x00\x3d\xfe\x00\x00\x3c\xfe\x00\x00\x00\x00\x07\xff\xf9\xfe\x3c\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x97\xff\x76\xff\x6b\xff\x26\xff\xa6\xff\x3a\xfe\x00\x00\x5a\xff\x2b\xff\x2f\xff\x2c\xff\x2d\xff\x2e\xff\x3d\xfe\x03\xff\xd7\xfe\xd5\xfe\xf4\xfe\x49\xfe\x00\x00\x96\xff\x75\xff\x6a\xff\x2a\xff\x26\xff\xa6\xff\x00\x00\x00\x00\x5d\xff\x00\x00\x66\xff\x54\xff\x53\xff\x62\xff\x92\xff\x91\xff\x61\xff\x6f\xff\x68\xff\x67\xff\xa9\xff\x6e\xff\x6d\xff\xaa\xff\x7b\xff\x72\xff\x73\xff\x71\xff\x7a\xff\x79\xff\x78\xff\x00\x00\x26\xff\x27\xff\x23\xff\x20\xff\x1f\xff\x24\xff\x16\xff\x28\xff\xa6\xff\x00\x00\x3d\xfe\x22\xff\x00\x00\x94\xff\x7c\xff\x70\xff\x26\xff\xa6\xff\x93\xff\x00\x00\x65\xff\x00\x00\x26\xff\xa6\xff\x3d\xfe\xa8\xff\x3d\xfe\xa7\xff\xf3\xff\x00\x00\x00\x00\x4a\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x3f\xfe\x4b\xfe\x00\x00\x00\x00\xbc\xff\x7d\xfe\x47\xfe\x00\x00\xbb\xff\x00\x00\xb4\xff\xd5\xff\x3d\xfe\xc6\xff\x3d\xfe\x3d\xfe\x00\x00\x85\xfe\x3d\xfe\x86\xfe\x8c\xfe\x42\xfe\x41\xfe\x8a\xfe\x3d\xfe\x88\xfe\x3d\xfe\x84\xfe\x8d\xfe\x8e\xfe\x00\x00\xde\xfe\x8a\xff\x89\xff\x88\xff\x00\x00\x00\x00\x00\x00\x3c\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\xfe\x00\x00\x5a\xfe\x56\xfe\x55\xfe\x59\xfe\x58\xfe\x57\xfe\x52\xfe\x51\xfe\x50\xfe\x54\xfe\x53\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x95\xfe\x94\xfe\xf8\xff\xf9\xff\x97\xfe\x96\xfe\x00\x00\x00\x00\x91\xfe\x99\xfe\x5b\xfe\x78\xfe\x79\xfe\x7a\xfe\x75\xfe\x76\xfe\x72\xfe\x73\xfe\x6d\xfe\x6f\xfe\x6e\xfe\x70\xfe\x6a\xfe\x6b\xfe\x68\xfe\x66\xfe\x64\xfe\x62\xfe\x00\x00\x00\x00\x60\xfe\x4d\xfe\x4e\xfe\xa3\xfe\x00\x00\xdb\xfe\xd8\xfe\xda\xfe\xd9\xfe\x00\x00\xdc\xfe\xf4\xfe\xc8\xfe\xdd\xfe\xa2\xfe\x00\x00\x00\x00\x40\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd6\xff\xd5\xff\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xff\x00\x00\x3d\xfe\x00\x00\x00\x00\xbe\xff\x00\x00\xba\xff\x00\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\xb6\xfe\x3d\xfe\x00\x00\xf1\xff\x3d\xfe\x3d\xfe\xb6\xfe\xef\xff\x21\xff\xf4\xfe\x00\x00\x1e\xff\x12\xff\x3c\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\xff\x3d\xfe\xb6\xfe\xf0\xff\x4e\xff\x4b\xff\x3d\xfe\x00\x00\x95\xff\x74\xff\x69\xff\x29\xff\x26\xff\xa6\xff\x00\x00\x57\xff\x3d\xfe\xb6\xfe\xee\xff\x49\xfe\x48\xfe\x00\x00\x49\xfe\x82\xfe\x3d\xfe\xef\xfe\xeb\xfe\xe8\xfe\x9a\xff\x89\xff\xe4\xfe\x00\x00\xf3\xfe\xf1\xfe\x00\x00\x3c\xfe\xe0\xfe\xd4\xfe\xec\xff\xa5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x3c\xfe\x3d\xfe\x3d\xfe\xb6\xfe\xf2\xff\x00\x00\x00\x00\x00\x00\x3d\xfe\xf6\xfe\xfd\xfe\x02\xff\x06\xff\x09\xff\x05\xff\xf8\xfe\x00\x00\x00\x00\x34\xff\x00\x00\x00\x00\x00\x00\x36\xfe\x00\x00\x38\xfe\x34\xfe\x35\xfe\x5f\xff\x5e\xff\x00\x00\x33\xff\x31\xff\x00\x00\x00\x00\x04\xff\x01\xff\xf5\xfe\x00\x00\x00\x00\xfc\xfe\x00\xff\xa1\xff\x00\x00\xeb\xff\x00\x00\x00\x00\x26\xff\x26\xff\x00\x00\x28\xff\x00\x00\x3d\xfe\x26\xff\xf7\xfe\x00\x00\x3d\xfe\xd6\xfe\x3d\xfe\xe2\xfe\x00\x00\xe3\xfe\xf4\xfe\xc8\xfe\x3d\xfe\x3d\xfe\xe7\xfe\xf4\xfe\xc8\xfe\x3d\xfe\xea\xfe\x3d\xfe\x3d\xfe\xee\xfe\x3d\xfe\x00\x00\x00\x00\x00\x00\x82\xfe\xd3\xfe\x00\x00\x00\x00\x49\xfe\x82\xfe\xa3\xff\xe7\xff\x3d\xfe\x3d\xfe\xb6\xfe\xed\xff\x00\x00\x00\x00\x3d\xfe\x4b\xff\x9d\xff\xe9\xff\x00\x00\x00\x00\x00\x00\x3d\xfe\x00\x00\x0f\xff\x1a\xff\x00\x00\x1d\xff\x1c\xff\x11\xff\x00\x00\x00\x00\xa4\xff\xe8\xff\x00\x00\x00\x00\x00\x00\x9f\xff\x9e\xff\xea\xff\x26\xff\x26\xff\x00\x00\x00\x00\x00\x00\xbd\xff\x4b\xfe\x4b\xfe\x00\x00\x00\x00\xdc\xff\x00\x00\x00\x00\xd6\xff\x00\x00\xd3\xff\x00\x00\xd4\xff\xd2\xff\xd0\xff\xd1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x60\xff\x3d\xfe\xdd\xff\x3d\xfe\x00\x00\x3d\xfe\x00\x00\x89\xfe\x87\xfe\x3d\xfe\xc6\xfe\xc4\xfe\x00\x00\x00\x00\x00\x00\x3c\xfe\xba\xfe\x7c\xfe\xb4\xfe\x00\x00\x5d\xfe\x00\x00\x98\xfe\x00\x00\x9a\xfe\x90\xfe\x5e\xfe\x4c\xfe\xb3\xfe\x00\x00\x00\x00\x00\x00\xac\xfe\xad\xfe\xb9\xfe\x00\x00\x00\x00\x00\x00\xb4\xfe\x00\x00\x00\x00\x00\x00\xc1\xfe\xc2\xfe\xc0\xfe\xc3\xfe\xc5\xfe\xc7\xfe\x3c\xfe\x00\x00\x00\x00\x9e\xfe\x00\x00\xcf\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\x00\x00\x00\x00\xc9\xff\x00\x00\xb3\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc5\xff\xc3\xff\xc2\xff\xb6\xfe\xb6\xfe\x00\x00\x64\xff\x63\xff\x00\x00\x1b\xff\x10\xff\x00\x00\x15\xff\x19\xff\x0d\xff\x0e\xff\x00\x00\x18\xff\x0b\xff\x3d\xfe\x40\xff\x49\xff\x00\x00\x00\x00\x3d\xfe\x3c\xfe\x4a\xff\x4f\xff\x3d\xfe\x5c\xff\x5b\xff\xa2\xff\xe6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x82\xfe\x3d\xfe\xd1\xfe\x00\x00\xd2\xfe\xcc\xfe\x00\x00\x00\x00\xed\xfe\xec\xfe\xe9\xfe\x3d\xfe\xc4\xfe\x3c\xfe\xe6\xfe\xe5\xfe\x3d\xfe\xc4\xfe\x3c\xfe\xe1\xfe\xf0\xfe\xf2\xfe\xdf\xfe\x00\x00\x00\x00\x00\x00\x26\xff\x59\xff\x58\xff\xb5\xfe\xff\xfe\xf4\xff\x00\x00\x00\x00\x00\x00\x38\xff\x00\x00\x00\x00\x36\xfe\x37\xfe\x39\xfe\x31\xfe\x00\x00\x32\xfe\x32\xff\x37\xff\x30\xff\x00\x00\x36\xff\x00\x00\x3c\xfe\x3c\xfe\x00\x00\xcf\xfe\xcb\xfe\x00\x00\x00\x00\xd0\xfe\xca\xfe\x56\xff\x55\xff\x46\xff\x44\xff\x3c\xff\x00\x00\x00\x00\x3c\xfe\x3d\xfe\x48\xff\x3d\xfe\x47\xff\x3d\xfe\x3f\xff\x00\x00\x50\xff\x17\xff\x00\x00\x00\x00\x14\xff\x25\xff\x9c\xff\xa0\xff\x00\x00\x4b\xfe\x4b\xfe\x00\x00\xda\xff\x00\x00\xb2\xff\xb1\xff\x00\x00\x00\x00\xb9\xff\xd8\xff\xc8\xff\xce\xff\xcc\xff\xcd\xff\x00\x00\xcb\xff\x9f\xfe\xa0\xfe\x00\x00\x00\x00\xa1\xfe\xbf\xfe\xbd\xfe\xbe\xfe\xbc\xfe\x00\x00\xa9\xfe\x00\x00\xae\xfe\xab\xfe\xa8\xfe\xaf\xfe\xb2\xfe\x00\x00\x93\xfe\xb1\xfe\x00\x00\x92\xfe\xaa\xfe\x00\x00\x00\x00\xb8\xfe\xbb\xfe\x9d\xfe\x00\x00\xca\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\xff\xc1\xff\x00\x00\x00\x00\xc4\xff\x13\xff\x3e\xff\x00\x00\x42\xff\x00\x00\x00\x00\x45\xff\x3b\xff\x00\x00\x39\xff\xc9\xfe\x00\x00\xce\xfe\x35\xff\x33\xfe\x00\x00\x30\xfe\xcd\xfe\x3a\xff\x3d\xfe\x43\xff\x3d\xff\x00\x00\x00\x00\x00\x00\xb8\xff\xb0\xff\x00\x00\x00\x00\x00\x00\x9c\xfe\xb7\xfe\x00\x00\xb0\xfe\xa7\xfe\x00\x00\x00\x00\xaf\xff\x00\x00\x00\x00\xd6\xff\xc0\xff\x41\xff\xbf\xff\x00\x00\xac\xff\xb7\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\xff\xb6\xff\xad\xff\xae\xff"# happyCheck :: HappyAddr happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x04\x00\x36\x00\x74\x00\x15\x00\x16\x00\x17\x00\x15\x00\x16\x00\x17\x00\x17\x00\x04\x00\x35\x00\x01\x00\x01\x00\x18\x00\x03\x00\x01\x00\x04\x00\x02\x00\x1c\x00\x02\x00\x19\x00\x74\x00\x1b\x00\x0d\x00\x1d\x00\x1e\x00\x1f\x00\x0d\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\x01\x00\x03\x00\x14\x00\x02\x00\x5b\x00\x0d\x00\x33\x00\x39\x00\x20\x00\x21\x00\x37\x00\x23\x00\x0d\x00\x21\x00\x02\x00\x03\x00\x04\x00\x1e\x00\x2e\x00\x2a\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x79\x00\x01\x00\x79\x00\x36\x00\x76\x00\x01\x00\x2e\x00\x36\x00\x76\x00\x36\x00\x19\x00\x09\x00\x1b\x00\x0d\x00\x1d\x00\x1e\x00\x1f\x00\x0d\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\x74\x00\x01\x00\x5e\x00\x74\x00\x74\x00\x5c\x00\x33\x00\x5e\x00\x74\x00\x5c\x00\x37\x00\x5e\x00\x5e\x00\x0d\x00\x02\x00\x03\x00\x04\x00\x77\x00\x78\x00\x79\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x5c\x00\x5d\x00\x42\x00\x43\x00\x44\x00\x5b\x00\x36\x00\x5c\x00\x5d\x00\x5e\x00\x19\x00\x5e\x00\x1b\x00\x79\x00\x1d\x00\x1e\x00\x1f\x00\x79\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\x04\x00\x01\x00\x01\x00\x79\x00\x03\x00\x5c\x00\x33\x00\x5e\x00\x74\x00\x5c\x00\x37\x00\x5e\x00\x02\x00\x0d\x00\x0d\x00\x36\x00\x36\x00\x77\x00\x78\x00\x79\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x79\x00\x76\x00\x21\x00\x1e\x00\x23\x00\x23\x00\x01\x00\x07\x00\x5c\x00\x5d\x00\x5e\x00\x2a\x00\x2b\x00\x2c\x00\x04\x00\x7b\x00\x79\x00\x01\x00\x0d\x00\x02\x00\x33\x00\x01\x00\x2c\x00\x36\x00\x36\x00\x2a\x00\x5c\x00\x54\x00\x36\x00\x0d\x00\x02\x00\x54\x00\x01\x00\x0d\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x43\x00\x20\x00\x21\x00\x0d\x00\x23\x00\x48\x00\x77\x00\x78\x00\x79\x00\x01\x00\x21\x00\x2a\x00\x2b\x00\x2c\x00\x04\x00\x79\x00\x01\x00\x1e\x00\x2a\x00\x56\x00\x33\x00\x0d\x00\x79\x00\x36\x00\x5c\x00\x5c\x00\x5d\x00\x5e\x00\x0d\x00\x5c\x00\x5d\x00\x36\x00\x01\x00\x36\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x2d\x00\x02\x00\x21\x00\x0d\x00\x23\x00\x43\x00\x36\x00\x78\x00\x79\x00\x79\x00\x48\x00\x2a\x00\x2b\x00\x2c\x00\x04\x00\x5c\x00\x5d\x00\x5e\x00\x02\x00\x07\x00\x33\x00\x01\x00\x2d\x00\x36\x00\x56\x00\x07\x00\x5c\x00\x5d\x00\x5e\x00\x1e\x00\x5c\x00\x5d\x00\x5e\x00\x0d\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x5c\x00\x5d\x00\x21\x00\x21\x00\x23\x00\x23\x00\x5c\x00\x5d\x00\x79\x00\x07\x00\x01\x00\x2a\x00\x2b\x00\x2c\x00\x04\x00\x07\x00\x79\x00\x2a\x00\x5c\x00\x04\x00\x33\x00\x76\x00\x0d\x00\x37\x00\x36\x00\x5c\x00\x5d\x00\x5e\x00\x5c\x00\x5d\x00\x77\x00\x78\x00\x79\x00\x36\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x5c\x00\x5d\x00\x21\x00\x01\x00\x23\x00\x43\x00\x20\x00\x21\x00\x79\x00\x23\x00\x48\x00\x2a\x00\x2b\x00\x2c\x00\x04\x00\x0d\x00\x2a\x00\x2b\x00\x2c\x00\x02\x00\x33\x00\x79\x00\x1c\x00\x36\x00\x56\x00\x33\x00\x7a\x00\x7b\x00\x36\x00\x1c\x00\x5c\x00\x5d\x00\x5e\x00\x4b\x00\x41\x00\x42\x00\x43\x00\x44\x00\x74\x00\x41\x00\x42\x00\x43\x00\x44\x00\x21\x00\x2d\x00\x23\x00\x77\x00\x78\x00\x79\x00\x79\x00\x79\x00\x39\x00\x2a\x00\x2b\x00\x2c\x00\x01\x00\x36\x00\x54\x00\x39\x00\x2a\x00\x5c\x00\x33\x00\x5e\x00\x03\x00\x36\x00\x21\x00\x06\x00\x0d\x00\x54\x00\x43\x00\x05\x00\x06\x00\x07\x00\x2c\x00\x48\x00\x41\x00\x42\x00\x43\x00\x44\x00\x02\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x01\x00\x36\x00\x54\x00\x56\x00\x78\x00\x79\x00\x1f\x00\x34\x00\x35\x00\x5c\x00\x79\x00\x5e\x00\x0d\x00\x20\x00\x21\x00\x2a\x00\x20\x00\x21\x00\x2d\x00\x05\x00\x06\x00\x07\x00\x1e\x00\x09\x00\x1a\x00\x0b\x00\x0c\x00\x0d\x00\x07\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x2d\x00\x36\x00\x5c\x00\x5d\x00\x36\x00\x19\x00\x01\x00\x1b\x00\x03\x00\x1d\x00\x1e\x00\x1f\x00\x79\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\x34\x00\x35\x00\x5c\x00\x5d\x00\x5e\x00\x74\x00\x33\x00\x54\x00\x0a\x00\x79\x00\x37\x00\x5a\x00\x0e\x00\x5c\x00\x76\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\x54\x00\x6e\x00\x5c\x00\x5d\x00\x5e\x00\x1c\x00\x73\x00\x74\x00\x1c\x00\x76\x00\x42\x00\x43\x00\x44\x00\x79\x00\x2c\x00\x5a\x00\x79\x00\x5c\x00\x30\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\x39\x00\x6e\x00\x76\x00\x39\x00\x54\x00\x1c\x00\x73\x00\x74\x00\x4b\x00\x76\x00\x77\x00\x78\x00\x79\x00\x05\x00\x06\x00\x07\x00\x0a\x00\x09\x00\x79\x00\x0b\x00\x0c\x00\x0d\x00\x76\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x01\x00\x1c\x00\x78\x00\x79\x00\x1c\x00\x19\x00\x39\x00\x1b\x00\x76\x00\x1d\x00\x1e\x00\x1f\x00\x0d\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\x07\x00\x77\x00\x78\x00\x79\x00\x1c\x00\x39\x00\x33\x00\x07\x00\x39\x00\x1c\x00\x37\x00\x1c\x00\x1c\x00\x01\x00\x1a\x00\x2a\x00\x3c\x00\x3d\x00\x2d\x00\x01\x00\x1a\x00\x03\x00\x42\x00\x43\x00\x44\x00\x0d\x00\x07\x00\x22\x00\x23\x00\x1a\x00\x25\x00\x0d\x00\x27\x00\x39\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x39\x00\x07\x00\x39\x00\x39\x00\x20\x00\x21\x00\x33\x00\x5a\x00\x76\x00\x5c\x00\x37\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\x36\x00\x6e\x00\x5c\x00\x5d\x00\x5e\x00\x4c\x00\x73\x00\x74\x00\x1a\x00\x76\x00\x77\x00\x78\x00\x79\x00\x79\x00\x07\x00\x41\x00\x42\x00\x43\x00\x44\x00\x5a\x00\x50\x00\x5c\x00\x1a\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\x07\x00\x6e\x00\x5c\x00\x5d\x00\x5e\x00\x07\x00\x73\x00\x74\x00\x5c\x00\x5d\x00\x77\x00\x78\x00\x79\x00\x01\x00\x79\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x2a\x00\x74\x00\x03\x00\x2d\x00\x0d\x00\x06\x00\x22\x00\x23\x00\x79\x00\x25\x00\x76\x00\x27\x00\x79\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x07\x00\x02\x00\x03\x00\x36\x00\x1e\x00\x06\x00\x33\x00\x58\x00\x59\x00\x2a\x00\x37\x00\x36\x00\x2d\x00\x1f\x00\x1a\x00\x36\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x79\x00\x41\x00\x42\x00\x43\x00\x44\x00\x07\x00\x22\x00\x23\x00\x76\x00\x25\x00\x4c\x00\x27\x00\x08\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x33\x00\x5a\x00\x75\x00\x5c\x00\x37\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\x76\x00\x6e\x00\x5c\x00\x5d\x00\x6d\x00\x4c\x00\x73\x00\x74\x00\x00\x00\x01\x00\x77\x00\x78\x00\x79\x00\x78\x00\x79\x00\x01\x00\x77\x00\x78\x00\x79\x00\x5a\x00\x2b\x00\x5c\x00\x5b\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\x07\x00\x6e\x00\x41\x00\x42\x00\x43\x00\x44\x00\x73\x00\x74\x00\x36\x00\x02\x00\x77\x00\x78\x00\x79\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x5b\x00\x41\x00\x42\x00\x43\x00\x44\x00\x07\x00\x46\x00\x47\x00\x02\x00\x22\x00\x23\x00\x2b\x00\x25\x00\x01\x00\x27\x00\x01\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x4e\x00\x4f\x00\x50\x00\x19\x00\x04\x00\x1b\x00\x33\x00\x1d\x00\x1e\x00\x1f\x00\x37\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\x32\x00\x13\x00\x14\x00\x15\x00\x16\x00\x5b\x00\x33\x00\x01\x00\x4c\x00\x03\x00\x37\x00\x5c\x00\x5d\x00\x78\x00\x79\x00\x41\x00\x42\x00\x43\x00\x44\x00\x0d\x00\x5c\x00\x5d\x00\x5a\x00\x5e\x00\x5c\x00\x02\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\x5a\x00\x6e\x00\x5c\x00\x04\x00\x5e\x00\x5f\x00\x73\x00\x74\x00\x2a\x00\x2b\x00\x77\x00\x78\x00\x79\x00\x21\x00\x5e\x00\x23\x00\x2a\x00\x2b\x00\x07\x00\x2a\x00\x2b\x00\x23\x00\x2a\x00\x2b\x00\x2c\x00\x73\x00\x74\x00\x02\x00\x2a\x00\x2b\x00\x2c\x00\x33\x00\x02\x00\x77\x00\x78\x00\x79\x00\x19\x00\x33\x00\x1b\x00\x2b\x00\x1d\x00\x1e\x00\x1f\x00\x04\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\x07\x00\x2a\x00\x2b\x00\x36\x00\x5c\x00\x5d\x00\x33\x00\x4e\x00\x4f\x00\x50\x00\x37\x00\x77\x00\x78\x00\x79\x00\x41\x00\x42\x00\x43\x00\x44\x00\x19\x00\x04\x00\x1b\x00\x04\x00\x1d\x00\x1e\x00\x1f\x00\x2c\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\x5a\x00\x2a\x00\x5c\x00\x01\x00\x5e\x00\x5f\x00\x33\x00\x79\x00\x2b\x00\x21\x00\x37\x00\x23\x00\x1e\x00\x79\x00\x5e\x00\x23\x00\x5c\x00\x5d\x00\x2a\x00\x2b\x00\x2c\x00\x07\x00\x2a\x00\x2b\x00\x2c\x00\x73\x00\x74\x00\x33\x00\x17\x00\x18\x00\x36\x00\x33\x00\x79\x00\x1e\x00\x36\x00\x5e\x00\x77\x00\x78\x00\x79\x00\x19\x00\x04\x00\x1b\x00\x04\x00\x1d\x00\x1e\x00\x1f\x00\x30\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\x07\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x33\x00\x42\x00\x43\x00\x44\x00\x37\x00\x46\x00\x47\x00\x11\x00\x12\x00\x77\x00\x78\x00\x79\x00\x19\x00\x02\x00\x1b\x00\x5e\x00\x1d\x00\x1e\x00\x1f\x00\x04\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\x79\x00\x36\x00\x77\x00\x78\x00\x79\x00\x04\x00\x33\x00\x77\x00\x78\x00\x79\x00\x37\x00\x23\x00\x41\x00\x42\x00\x43\x00\x44\x00\x32\x00\x04\x00\x2a\x00\x2b\x00\x2c\x00\x07\x00\x04\x00\x78\x00\x79\x00\x5c\x00\x5d\x00\x33\x00\x0b\x00\x0c\x00\x36\x00\x41\x00\x42\x00\x43\x00\x44\x00\x02\x00\x77\x00\x78\x00\x79\x00\x19\x00\x02\x00\x1b\x00\x02\x00\x1d\x00\x1e\x00\x1f\x00\x1f\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\x07\x00\x01\x00\x2d\x00\x03\x00\x2a\x00\x2b\x00\x33\x00\x3c\x00\x78\x00\x79\x00\x37\x00\x2a\x00\x2b\x00\x0d\x00\x2b\x00\x77\x00\x78\x00\x79\x00\x19\x00\x2b\x00\x1b\x00\x02\x00\x1d\x00\x1e\x00\x1f\x00\x2b\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\x79\x00\x05\x00\x06\x00\x07\x00\x5c\x00\x5d\x00\x33\x00\x36\x00\x1c\x00\x1d\x00\x37\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x36\x00\x21\x00\x2c\x00\x23\x00\x43\x00\x77\x00\x78\x00\x79\x00\x1e\x00\x48\x00\x2a\x00\x2b\x00\x2c\x00\x43\x00\x05\x00\x06\x00\x07\x00\x02\x00\x48\x00\x33\x00\x77\x00\x78\x00\x79\x00\x56\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x17\x00\x18\x00\x5e\x00\x56\x00\x02\x00\x42\x00\x43\x00\x44\x00\x02\x00\x5c\x00\x5d\x00\x5e\x00\x05\x00\x06\x00\x07\x00\x11\x00\x12\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x37\x00\x02\x00\x77\x00\x78\x00\x79\x00\x77\x00\x78\x00\x79\x00\x0b\x00\x0c\x00\x41\x00\x42\x00\x43\x00\x44\x00\x5a\x00\x02\x00\x5c\x00\x02\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\x79\x00\x6e\x00\x77\x00\x78\x00\x79\x00\x2c\x00\x73\x00\x74\x00\x1e\x00\x76\x00\x5a\x00\x5c\x00\x5c\x00\x2d\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\x1e\x00\x6e\x00\x77\x00\x78\x00\x79\x00\x30\x00\x73\x00\x74\x00\x5a\x00\x76\x00\x5c\x00\x5b\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\x02\x00\x6e\x00\x05\x00\x06\x00\x07\x00\x36\x00\x73\x00\x74\x00\x02\x00\x76\x00\x02\x00\x02\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x1f\x00\x43\x00\x04\x00\x02\x00\x36\x00\x02\x00\x48\x00\x4d\x00\x04\x00\x3b\x00\x3c\x00\x3d\x00\x05\x00\x06\x00\x07\x00\x41\x00\x42\x00\x43\x00\x44\x00\x04\x00\x56\x00\x04\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x3b\x00\x3c\x00\x3d\x00\x4e\x00\x4f\x00\x50\x00\x41\x00\x42\x00\x43\x00\x44\x00\x5e\x00\x5c\x00\x05\x00\x06\x00\x07\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x30\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x38\x00\x02\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x02\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x5a\x00\x79\x00\x5c\x00\x2b\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\x79\x00\x6e\x00\x4e\x00\x4f\x00\x50\x00\x1f\x00\x73\x00\x74\x00\x5a\x00\x76\x00\x5c\x00\x01\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\x02\x00\x6e\x00\x4e\x00\x4f\x00\x50\x00\x02\x00\x73\x00\x74\x00\x5a\x00\x76\x00\x5c\x00\x02\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\x02\x00\x6e\x00\x05\x00\x06\x00\x07\x00\x2c\x00\x73\x00\x74\x00\x1f\x00\x76\x00\x2a\x00\x02\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x5e\x00\x04\x00\x04\x00\x4e\x00\x4f\x00\x50\x00\x4e\x00\x4f\x00\x50\x00\x3b\x00\x3c\x00\x3d\x00\x05\x00\x06\x00\x07\x00\x41\x00\x42\x00\x43\x00\x44\x00\x4e\x00\x4f\x00\x50\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x4e\x00\x4f\x00\x50\x00\x77\x00\x78\x00\x79\x00\x05\x00\x06\x00\x07\x00\x77\x00\x78\x00\x79\x00\x77\x00\x78\x00\x79\x00\x1f\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x38\x00\x01\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x2c\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x5a\x00\x79\x00\x5c\x00\x2c\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\x1f\x00\x6e\x00\x77\x00\x78\x00\x79\x00\x02\x00\x73\x00\x74\x00\x5a\x00\x76\x00\x5c\x00\x02\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\x08\x00\x6e\x00\x77\x00\x78\x00\x79\x00\x1f\x00\x73\x00\x74\x00\x5a\x00\x76\x00\x5c\x00\x01\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\x5e\x00\x6e\x00\x05\x00\x06\x00\x07\x00\x1f\x00\x73\x00\x74\x00\x02\x00\x76\x00\x02\x00\x02\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x01\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x2b\x00\x42\x00\x43\x00\x44\x00\x2b\x00\x5b\x00\x05\x00\x06\x00\x07\x00\x41\x00\x42\x00\x43\x00\x44\x00\x77\x00\x78\x00\x79\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x77\x00\x78\x00\x79\x00\x5c\x00\x2a\x00\x5a\x00\x46\x00\x5c\x00\x02\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\x2a\x00\x6e\x00\x2a\x00\x70\x00\x78\x00\x79\x00\x73\x00\x74\x00\x77\x00\x78\x00\x79\x00\x02\x00\x02\x00\x5a\x00\x79\x00\x5c\x00\x5e\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\x2a\x00\x6e\x00\x4e\x00\x4f\x00\x50\x00\x1e\x00\x73\x00\x74\x00\x5a\x00\x76\x00\x5c\x00\x1a\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\x1b\x00\x6e\x00\x0c\x00\x0d\x00\x19\x00\x10\x00\x73\x00\x74\x00\x04\x00\x76\x00\x01\x00\x5b\x00\x03\x00\x02\x00\x02\x00\x19\x00\x02\x00\x1b\x00\x5e\x00\x1d\x00\x1e\x00\x1f\x00\x0d\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\x4e\x00\x4f\x00\x50\x00\x01\x00\x20\x00\x21\x00\x33\x00\x23\x00\x57\x00\x2b\x00\x37\x00\x4e\x00\x4f\x00\x50\x00\x2a\x00\x2b\x00\x2c\x00\x46\x00\x4e\x00\x4f\x00\x50\x00\x2b\x00\x5e\x00\x33\x00\x2c\x00\x01\x00\x36\x00\x2c\x00\x36\x00\x5a\x00\x01\x00\x5c\x00\x30\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x41\x00\x42\x00\x43\x00\x44\x00\x43\x00\x0d\x00\x2c\x00\x30\x00\x5a\x00\x48\x00\x5c\x00\x2c\x00\x5e\x00\x5f\x00\x60\x00\x37\x00\x01\x00\x73\x00\x74\x00\x3b\x00\x3c\x00\x3d\x00\x2c\x00\x56\x00\x03\x00\x41\x00\x42\x00\x43\x00\x44\x00\x5c\x00\x5d\x00\x5e\x00\x01\x00\x73\x00\x74\x00\x2b\x00\x02\x00\x77\x00\x78\x00\x79\x00\x30\x00\x31\x00\x2c\x00\x33\x00\x02\x00\x35\x00\x5b\x00\x5e\x00\x38\x00\x01\x00\x65\x00\x3b\x00\x01\x00\x3d\x00\x3e\x00\x3f\x00\x79\x00\x4e\x00\x4f\x00\x50\x00\x44\x00\x45\x00\x01\x00\x47\x00\x04\x00\x5e\x00\x4a\x00\x4b\x00\x01\x00\x4d\x00\x4e\x00\x5e\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x01\x00\x77\x00\x78\x00\x79\x00\x2c\x00\x65\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x01\x00\x77\x00\x78\x00\x79\x00\x1e\x00\x65\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x01\x00\x01\x00\x10\x00\x4e\x00\x4f\x00\x50\x00\x5a\x00\x1e\x00\x5c\x00\x01\x00\x5e\x00\x5f\x00\x60\x00\x1b\x00\x2b\x00\x38\x00\x2b\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x1e\x00\x41\x00\x42\x00\x43\x00\x44\x00\x2b\x00\x2b\x00\x2c\x00\x73\x00\x74\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\x65\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x01\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\x01\x00\x77\x00\x78\x00\x79\x00\x01\x00\x01\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x5b\x00\x31\x00\x10\x00\x65\x00\x2a\x00\x5a\x00\x36\x00\x5c\x00\x1b\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x1b\x00\x3e\x00\x77\x00\x78\x00\x79\x00\x1a\x00\x43\x00\x77\x00\x78\x00\x79\x00\x47\x00\x48\x00\x77\x00\x78\x00\x79\x00\x19\x00\x4d\x00\x73\x00\x74\x00\x50\x00\x2f\x00\x52\x00\x31\x00\x10\x00\x33\x00\x56\x00\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x5e\x00\x3d\x00\x3e\x00\x3f\x00\x4e\x00\x4f\x00\x50\x00\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\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\x01\x00\x4e\x00\x4f\x00\x50\x00\xff\xff\x36\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\x47\x00\x19\x00\xff\xff\x1b\x00\x1b\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x77\x00\x78\x00\x79\x00\x2f\x00\xff\xff\x31\x00\x33\x00\x33\x00\xff\xff\x35\x00\x37\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\x4e\x00\x4f\x00\x50\x00\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\x78\x00\x79\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\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\x01\x00\x77\x00\x78\x00\x79\x00\xff\xff\x37\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\x77\x00\x78\x00\x79\x00\x01\x00\x02\x00\x03\x00\x01\x00\x02\x00\x03\x00\x1b\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x01\x00\x02\x00\x03\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x42\x00\x43\x00\x44\x00\x33\x00\x01\x00\x35\x00\x03\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\x0d\x00\x01\x00\x02\x00\x03\x00\x44\x00\x45\x00\x77\x00\x78\x00\x79\x00\xff\xff\x4a\x00\x4b\x00\x4c\x00\x04\x00\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\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\x01\x00\x78\x00\x79\x00\xff\xff\x36\x00\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x01\x00\x43\x00\x03\x00\xff\xff\x05\x00\x06\x00\x48\x00\xff\xff\x09\x00\x0a\x00\x1b\x00\xff\xff\x38\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x56\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x33\x00\x01\x00\x35\x00\x03\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\x0d\x00\x0d\x00\x0e\x00\x0f\x00\x44\x00\x45\x00\x01\x00\x02\x00\x03\x00\xff\xff\x4a\x00\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\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\x01\x00\x0d\x00\x0e\x00\x0f\x00\x36\x00\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\x43\x00\x36\x00\xff\xff\xff\xff\xff\xff\x48\x00\x3b\x00\x3c\x00\x3d\x00\x1b\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\x5a\x00\x56\x00\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x2b\x00\x2c\x00\x5e\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\x39\x00\x3a\x00\x37\x00\xff\xff\x73\x00\x74\x00\xff\xff\x40\x00\x41\x00\x42\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x49\x00\x46\x00\x47\x00\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\x01\x00\xff\xff\x03\x00\x78\x00\x79\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x0d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\x1b\x00\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\x36\x00\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x43\x00\x01\x00\xff\xff\x03\x00\xff\xff\x48\x00\x5c\x00\x5d\x00\x5e\x00\x4c\x00\x4d\x00\xff\xff\x5a\x00\x0d\x00\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x1b\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\x2f\x00\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x43\x00\x03\x00\xff\xff\x01\x00\xff\xff\x48\x00\x01\x00\xff\xff\xff\xff\x4c\x00\x4d\x00\x0d\x00\x42\x00\x43\x00\x44\x00\x0d\x00\x46\x00\x47\x00\x0d\x00\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\x36\x00\x5a\x00\xff\xff\x5c\x00\x36\x00\x5e\x00\x5f\x00\x36\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\x78\x00\x79\x00\xff\xff\x43\x00\x48\x00\xff\xff\x43\x00\xff\xff\x48\x00\xff\xff\xff\xff\x48\x00\x73\x00\x74\x00\x2f\x00\x5a\x00\xff\xff\x5c\x00\x56\x00\x5e\x00\x5f\x00\x36\x00\x56\x00\xff\xff\x5c\x00\x56\x00\x5e\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5c\x00\x5d\x00\x5e\x00\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x73\x00\x74\x00\xff\xff\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x01\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\xff\xff\x03\x00\xff\xff\x0d\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x01\x00\x1b\x00\x03\x00\xff\xff\xff\xff\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x73\x00\x74\x00\x2c\x00\x2d\x00\x36\x00\x2f\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x1b\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\x2d\x00\xff\xff\x2f\x00\xff\xff\x73\x00\x74\x00\x4c\x00\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x4c\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\x1b\x00\x46\x00\x47\x00\x5a\x00\x01\x00\x5c\x00\x03\x00\x5e\x00\x5f\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x00\x73\x00\x74\x00\x1b\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\x2c\x00\xff\xff\x4c\x00\x2f\x00\x78\x00\x79\x00\xff\xff\x01\x00\xff\xff\x03\x00\x73\x00\x74\x00\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x0d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\x73\x00\x74\x00\x36\x00\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x1b\x00\x5e\x00\x5f\x00\x60\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x5e\x00\xff\xff\x10\x00\x2f\x00\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x36\x00\xff\xff\x5a\x00\x1b\x00\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\x2c\x00\xff\xff\x4c\x00\x2f\x00\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\xff\xff\x36\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x01\x00\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\x02\x00\xff\xff\xff\xff\x0d\x00\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x01\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x79\x00\xff\xff\x10\x00\x73\x00\x74\x00\xff\xff\xff\xff\x36\x00\x2f\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x1b\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x73\x00\x74\x00\x4c\x00\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x4c\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x1b\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x2c\x00\xff\xff\x5a\x00\x2f\x00\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\xff\xff\x1b\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x73\x00\x74\x00\xff\xff\x2f\x00\xff\xff\x4c\x00\x78\x00\x79\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x2f\x00\xff\xff\x4c\x00\xff\xff\xff\xff\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\xff\xff\xff\xff\x4c\x00\x73\x00\x74\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x78\x00\x79\x00\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x2f\x00\x37\x00\xff\xff\xff\xff\x4c\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x1b\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x4c\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\x01\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\x2f\x00\xff\xff\xff\xff\xff\xff\x4c\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x4c\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\x0d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x0d\x00\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\xff\xff\xff\xff\xff\xff\x36\x00\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x30\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\x56\x00\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\x5e\x00\xff\xff\x2f\x00\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x01\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x4c\x00\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x01\x00\x31\x00\x03\x00\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\x31\x00\xff\xff\x33\x00\x0d\x00\x35\x00\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x01\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x5d\x00\x5e\x00\x38\x00\xff\xff\xff\xff\x3b\x00\x0d\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\xff\xff\x0d\x00\x38\x00\xff\xff\x01\x00\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\x0d\x00\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x01\x00\x1e\x00\x03\x00\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\x36\x00\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\x43\x00\x35\x00\xff\xff\xff\xff\x38\x00\x48\x00\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\x56\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x5c\x00\x4e\x00\x5e\x00\xff\xff\x51\x00\x36\x00\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x43\x00\xff\xff\xff\xff\x1e\x00\x1f\x00\x48\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\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\x5c\x00\xff\xff\x5e\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xff\xff\xff\xff\xff\xff\x1e\x00\x1f\x00\xff\xff\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x33\x00\x42\x00\x43\x00\x44\x00\x37\x00\x46\x00\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x1e\x00\x1f\x00\xff\xff\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\x78\x00\x79\x00\x37\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x1e\x00\x1f\x00\xff\xff\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x33\x00\x42\x00\x43\x00\x44\x00\x37\x00\x46\x00\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\x1f\x00\xff\xff\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\x37\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\x1e\x00\x1f\x00\xff\xff\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\x20\x00\x21\x00\xff\xff\x23\x00\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\x37\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\x21\x00\x36\x00\x23\x00\xff\xff\x77\x00\x78\x00\x79\x00\x4a\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\x36\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\x21\x00\xff\xff\x23\x00\xff\xff\x21\x00\xff\xff\x23\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x79\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\x36\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\xff\xff\x78\x00\x79\x00\x42\x00\x43\x00\x44\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x21\x00\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\x21\x00\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x33\x00\x79\x00\xff\xff\x36\x00\x78\x00\x79\x00\x33\x00\xff\xff\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x22\x00\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\x23\x00\x33\x00\x25\x00\xff\xff\x27\x00\x37\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x79\x00\xff\xff\xff\xff\xff\xff\x5a\x00\x4c\x00\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\x22\x00\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\x37\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x22\x00\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\x4c\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\x5a\x00\x37\x00\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\x4c\x00\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\x22\x00\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\x37\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x22\x00\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\x4c\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\x5a\x00\x37\x00\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\x4c\x00\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\x22\x00\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x22\x00\x23\x00\x33\x00\x25\x00\xff\xff\x27\x00\x37\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x22\x00\x23\x00\x33\x00\x25\x00\xff\xff\x27\x00\x37\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\x22\x00\x23\x00\x37\x00\x25\x00\xff\xff\x27\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\x37\x00\xff\xff\x4c\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\x77\x00\x78\x00\x79\x00\xff\xff\x22\x00\x23\x00\x4c\x00\x25\x00\xff\xff\x27\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\x2c\x00\x77\x00\x78\x00\x79\x00\xff\xff\x23\x00\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\x37\x00\x2a\x00\x2b\x00\x2c\x00\x36\x00\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\x36\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xff\xff\xff\xff\xff\xff\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x23\x00\xff\xff\xff\xff\x36\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\x78\x00\x79\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\x36\x00\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\x74\x00\xff\xff\x37\x00\x77\x00\x78\x00\x79\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\x47\x00\xff\xff\xff\xff\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\x5c\x00\xff\xff\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\x37\x00\xff\xff\xff\xff\x36\x00\x71\x00\xff\xff\x73\x00\x74\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\x79\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\x79\x00\x37\x00\x77\x00\x78\x00\x79\x00\x3b\x00\x3c\x00\x3d\x00\x37\x00\x36\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xff\xff\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x77\x00\x78\x00\x79\x00\xff\xff\xff\xff\x73\x00\x74\x00\x77\x00\x78\x00\x79\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x5d\x00\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\x2b\x00\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\x36\x00\xff\xff\x5d\x00\x5e\x00\x5f\x00\x2b\x00\xff\xff\xff\xff\x3e\x00\xff\xff\xff\xff\x31\x00\xff\xff\x43\x00\xff\xff\xff\xff\x36\x00\x47\x00\x48\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\x3e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x43\x00\xff\xff\xff\xff\x56\x00\x47\x00\x48\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\x5e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x2c\x00\xff\xff\xff\xff\x56\x00\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\xff\xff\x5e\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x5d\x00\x5e\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x5d\x00\x5e\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x5d\x00\x5e\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\x31\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\x54\x00\x55\x00\x56\x00\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\xff\xff\x5e\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5d\x00\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\x5d\x00\x5e\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\x5d\x00\x5e\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\x5d\x00\x5e\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\x5d\x00\x5e\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\xff\xff\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\x5d\x00\x5e\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\xff\xff\x33\x00\xff\xff\x35\x00\xff\xff\xff\xff\x38\x00\x5d\x00\x5e\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x51\x00\xff\xff\x53\x00\x54\x00\x55\x00\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\xff\xff\x38\x00\x5d\x00\x5e\x00\x3b\x00\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\x48\x00\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x5e\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x53\x00\x76\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x53\x00\x76\x00\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\x76\x00\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\x53\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x53\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x53\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\x74\x00\xff\xff\x5a\x00\xff\xff\x5c\x00\x79\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\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\x6f\x00\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x38\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x31\x00\x41\x00\x42\x00\x43\x00\x44\x00\xff\xff\xff\xff\x38\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x38\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x38\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x38\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\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"# happyTable :: HappyAddr happyTable = HappyA# "\x00\x00\x88\x00\x4c\x00\x4d\x00\xa2\x01\x7b\x03\x5e\x03\x12\x03\x13\x03\x11\x03\x12\x03\x13\x03\x60\x03\x3d\xfe\xe6\x02\x25\x02\x8d\x01\x72\x03\xaa\x00\xcb\x01\x35\x03\x25\x03\x1a\x02\x7a\x03\x4e\x00\x69\x03\x4f\x00\x26\x02\x50\x00\x51\x00\x52\x00\xcc\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xd4\x02\x16\x03\xf8\x00\x7b\x02\x82\x02\xef\x00\x5f\x00\x84\x01\xc7\x00\xb9\x00\x60\x00\xc8\x00\xf7\x01\xbc\x00\x3d\x01\x4c\x00\x4d\x00\x75\x01\x36\x03\x7b\x03\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x9c\x00\x25\x02\x4f\x03\xba\x00\x83\x02\xcb\x01\x76\x01\xbd\x00\xe2\x01\xf9\x00\x4e\x00\x71\x03\x4f\x00\x26\x02\x50\x00\x51\x00\x52\x00\xcc\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x14\x03\x97\x01\x86\x00\x14\x03\x14\x03\x84\x00\x5f\x00\x86\x00\x73\x03\x84\x00\x60\x00\x86\x00\x86\x00\xd6\x00\x4b\x00\x4c\x00\x4d\x00\x68\x00\x69\x00\x6a\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\xf0\x00\x4b\x00\xc8\x01\x63\x00\xc9\x01\x2a\x00\xb6\x00\x84\x00\x98\x01\x86\x00\x4e\x00\x86\x00\x4f\x00\xc9\x00\x50\x00\x51\x00\x52\x00\xbe\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\xaa\x00\xcb\x01\x06\x02\x4f\x03\xaa\x00\x84\x00\x5f\x00\x86\x00\x6a\x03\x84\x00\x60\x00\x86\x00\x55\x03\xcc\x01\x07\x02\xdd\x01\xbd\x00\x68\x00\x69\x00\x6a\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x9c\x00\x39\x03\xab\x00\xfb\x02\xac\x00\xc4\x00\x25\x02\x3b\x03\x84\x00\x98\x01\x86\x00\xad\x00\x5d\x00\x5e\x00\xd7\x00\xe1\x02\xb7\x00\xd3\x02\x26\x02\xe0\x02\x5f\x00\x25\x02\x9d\x01\xae\x00\xc5\x00\x56\x03\xde\x01\x0a\x03\x3c\xfe\xf7\x01\x6d\x03\x0b\x03\xf6\x01\x26\x02\xaf\x00\x62\x00\x63\x00\x64\x00\xb0\x00\x66\x00\x67\x00\x3c\xfe\xd8\x00\xb9\x00\xf7\x01\xd9\x00\x3c\xfe\x68\x00\x69\x00\x6a\x00\xcb\x01\xb5\x00\xda\x00\x5d\x00\x5e\x00\x9e\x01\xbe\x00\xd4\x02\x6e\x03\xe1\x02\x3c\xfe\x5f\x00\xcc\x01\x60\x02\xba\x00\x84\x00\x84\x00\xd7\x00\x86\x00\xf7\x01\xf0\x00\x4b\x00\xb6\x00\xd5\x00\xa1\x00\xdb\x00\x62\x00\x63\x00\x64\x00\xdc\x00\x66\x00\x67\x00\x54\x03\x41\x03\x9f\x01\xd6\x00\xa0\x01\xa2\x00\xae\x00\xb1\x00\x6a\x00\xc6\x00\xa3\x00\xa1\x01\x5d\x00\x5e\x00\x96\x00\x84\x00\xd7\x00\x86\x00\xf9\x01\x19\x03\x5f\x00\xec\x02\xe8\x02\xa2\x01\xa4\x00\x1a\x03\x84\x00\xd7\x00\x86\x00\x42\x03\x84\x00\xd7\x00\x86\x00\xf7\x01\xa3\x01\x62\x00\x63\x00\x64\x00\xa4\x01\x66\x00\x67\x00\x84\x00\xd7\x00\x97\x00\xc3\x00\x98\x00\xc4\x00\xf0\x00\x4b\x00\xdd\x00\x1b\x03\x6c\x00\x99\x00\x5d\x00\x5e\x00\x86\x02\x1d\x03\xb7\x00\xfa\x01\x84\x00\x89\x02\x5f\x00\x28\x03\x6d\x00\x0c\x02\xc5\x00\x84\x00\x98\x01\x86\x00\xf0\x00\x4b\x00\xc1\x02\x80\x02\x6a\x00\xa1\x00\x9a\x00\x62\x00\x63\x00\x64\x00\x9b\x00\x66\x00\x67\x00\x84\x00\xd7\x00\xab\x00\xcb\x01\xac\x00\xa2\x00\xd8\x00\xb9\x00\x9c\x00\xd9\x00\xa3\x00\xad\x00\x5d\x00\x5e\x00\x1c\x03\xcc\x01\xda\x00\x5d\x00\x5e\x00\x67\x02\x5f\x00\x60\x02\x98\x02\xae\x00\xa4\x00\x5f\x00\xda\x01\xdb\x01\xba\x00\x99\x02\x84\x00\xd7\x00\x86\x00\x8c\x02\xaf\x00\x62\x00\x63\x00\xd0\x01\x9a\x02\xdb\x00\x62\x00\x63\x00\xd0\x01\x9f\x01\xa8\x02\xa0\x01\x0d\x02\x8c\x00\x6a\x00\x9c\x00\xc6\x00\x84\x01\xa1\x01\x5d\x00\x5e\x00\x97\x01\xa1\x00\xb4\x02\x84\x01\x68\x02\x84\x00\x5f\x00\x86\x00\xa8\xfe\xa2\x01\xbc\x00\xa8\xfe\xd6\x00\xec\x01\xa2\x00\x6e\x03\x32\x00\x33\x00\xd7\x01\xa3\x00\xa3\x01\x62\x00\x63\x00\xd0\x01\x90\x02\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x25\x02\xbd\x00\x16\x02\xa4\x00\x87\x02\x6a\x00\xa8\xfe\xda\x02\xe1\x01\x84\x00\xdd\x00\x86\x00\x26\x02\xc0\x00\xb9\x00\x37\x03\xb8\x00\xb9\x00\x38\x03\x46\x02\x32\x00\x33\x00\x91\x02\x8d\x02\x19\x02\x48\x02\x49\x02\x4a\x02\x1b\x02\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x1e\x02\xba\x00\xf0\x00\x4b\x00\xba\x00\x4b\x02\xa9\x00\x4f\x00\xaa\x00\x50\x00\x4c\x02\x4d\x02\x9c\x00\x53\x00\x4e\x02\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xe0\x01\xe1\x01\x84\x00\x98\x01\x86\x00\x42\x02\x5f\x00\x20\x02\x70\x01\xbe\x00\x4f\x02\x06\x00\x71\x01\x07\x00\xe2\x01\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\x2f\x02\x39\x00\x84\x00\xd7\x00\x86\x00\x89\x01\x18\x00\x19\x00\xa8\x01\x3a\x00\x92\x00\x63\x00\xe9\x01\xc1\x00\xe5\xff\x06\x00\xbb\x00\x07\x00\x86\x01\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\x84\x01\x39\x00\xe2\x01\x84\x01\x35\x02\xc6\x01\x18\x00\x19\x00\x43\x02\x3a\x00\x68\x00\xc3\x01\x6a\x00\x46\x02\x32\x00\x33\x00\x44\x02\x47\x02\x60\x02\x48\x02\x49\x02\x4a\x02\x3f\x01\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x92\x01\x1a\x02\x95\x00\x6a\x00\x83\x01\x4b\x02\x84\x01\x4f\x00\x40\x01\x50\x00\x4c\x02\x4d\x02\xd6\x00\x53\x00\x4e\x02\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x0d\x01\x70\x03\x8c\x00\x6a\x00\x89\x01\x84\x01\x5f\x00\x86\x01\x84\x01\x99\x01\x4f\x02\xa8\x01\xc6\x01\x97\x01\x82\x01\xea\x02\x23\x02\xcf\x00\xeb\x02\x06\x02\x88\x01\xaa\x00\xc8\x01\x63\x00\xc9\x01\xd6\x00\x8a\x01\x0e\x01\x55\x00\x98\x01\x0f\x01\x07\x02\x10\x01\x84\x01\x11\x01\x5c\x00\x5d\x00\x5e\x00\x84\x01\x9a\x01\x84\x01\x84\x01\xc0\x00\xb9\x00\x5f\x00\x06\x00\x9b\x01\x07\x00\x12\x01\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\xba\x00\x39\x00\x84\x00\xd7\x00\x86\x00\x68\x01\x18\x00\x19\x00\xa7\x01\x3a\x00\x68\x00\xc3\x01\x6a\x00\x9c\x00\xa9\x01\xcf\x01\x62\x00\x63\x00\xd0\x01\x06\x00\xbc\x01\x07\x00\xc5\x01\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\x0d\x01\x14\x01\x84\x00\x98\x01\x86\x00\xc7\x01\x18\x00\x19\x00\x84\x00\xd7\x00\x68\x00\x15\x01\x6a\x00\xf6\x01\x9c\x00\x7d\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x30\x03\xd4\x01\x75\x02\x31\x03\xf7\x01\x76\x02\x0e\x01\x55\x00\xc1\x00\x0f\x01\xd5\x01\x10\x01\x9c\x00\x11\x01\x5c\x00\x5d\x00\x5e\x00\x0d\x01\x20\x03\x21\x03\x9f\x00\x04\x03\x22\x03\x5f\x00\x2b\x03\x2c\x03\xdd\x02\x12\x01\xae\x00\xde\x02\x2e\x03\xa4\x00\xae\x00\x2b\x02\xce\x00\xcf\x00\x2c\x02\xd1\x00\x9c\x00\xd1\x01\x62\x00\x63\x00\xd0\x01\xe7\x00\x0e\x01\x55\x00\xed\x00\x0f\x01\x69\x01\x10\x01\xfa\x00\x11\x01\x5c\x00\x5d\x00\x5e\x00\x7e\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x5f\x00\x06\x00\x04\x01\x07\x00\x12\x01\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\x0a\x01\x14\x01\x84\x00\xd7\x00\x2b\x01\x6b\x01\x18\x00\x19\x00\x87\x00\x05\x00\x68\x00\x15\x01\x6a\x00\x2d\x02\x6a\x00\x05\x00\x7f\x02\x80\x02\x6a\x00\x06\x00\x7d\x03\x07\x00\x2a\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\x0d\x01\x14\x01\x38\x02\x62\x00\x63\x00\xd0\x01\x18\x00\x19\x00\xae\x00\x7e\x03\x68\x00\x15\x01\x6a\x00\x2b\x02\xce\x00\xcf\x00\x2c\x02\xd1\x00\x2a\x00\xd1\x01\x62\x00\x63\x00\x64\x00\xb5\x02\xd2\x01\x67\x00\x7f\x03\x0e\x01\x55\x00\x75\x03\x0f\x01\x76\x03\x10\x01\x77\x03\x11\x01\x5c\x00\x5d\x00\x5e\x00\x38\x03\xa6\x00\xa7\x00\xbe\x01\x69\x03\x4f\x00\x5f\x00\x50\x00\xbf\x01\xc0\x01\x12\x01\x53\x00\xc1\x01\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5a\x03\x20\x01\x21\x01\x22\x01\x23\x01\x2a\x00\x5f\x00\x65\x01\x13\x01\xaa\x00\xc2\x01\xf0\x00\x4b\x00\x2d\x02\x6a\x00\xf9\x02\x62\x00\x63\x00\xd0\x01\x66\x01\x3d\x03\x3e\x03\x06\x00\x86\x00\x07\x00\x6c\x03\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\x06\x00\x14\x01\x07\x00\x58\x03\x00\x01\x09\x00\x18\x00\x19\x00\xfe\x02\xff\x02\x68\x00\x15\x01\x6a\x00\x97\x00\x86\x00\x98\x00\x00\x03\x01\x03\xee\x01\xfa\x01\x19\x03\x98\x00\x99\x00\x5d\x00\x5e\x00\x18\x00\x19\x00\x5d\x03\x99\x00\x5d\x00\x5e\x00\x5f\x00\x5e\x03\x68\x00\xc3\x01\x6a\x00\xbe\x01\x5f\x00\x4f\x00\x60\x03\x50\x00\xbf\x01\xc0\x01\x63\x03\x53\x00\xc1\x01\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x17\x02\xfa\x01\x8f\x02\xa2\x01\xf0\x00\x4b\x00\x5f\x00\x26\x02\xa6\x00\xa7\x00\xc2\x01\x49\x03\x8c\x00\x6a\x00\xe5\x01\x62\x00\x63\x00\xd0\x01\xbe\x01\x64\x03\x4f\x00\x65\x03\x50\x00\xbf\x01\xc0\x01\x3d\x00\x53\x00\xc1\x01\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x06\x00\x40\x03\x07\x00\x3f\x03\x02\x01\x09\x00\x5f\x00\x9c\x00\x43\x03\x9f\x01\xc2\x01\xa0\x01\x49\x03\x9c\x00\x86\x00\xac\x00\xf0\x00\x4b\x00\xa1\x01\x5d\x00\x5e\x00\x21\x02\xad\x00\x5d\x00\x5e\x00\x18\x00\x19\x00\x5f\x00\x1e\x01\x1f\x01\xa2\x01\x5f\x00\x9c\x00\x4f\x03\xae\x00\x86\x00\x68\x00\xc3\x01\x6a\x00\xbe\x01\x51\x03\x4f\x00\x53\x03\x50\x00\xbf\x01\xc0\x01\x86\x01\x53\x00\xc1\x01\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x30\x02\x92\x01\xcf\x00\x93\x01\xd1\x00\x9d\x02\x5f\x00\x92\x00\x63\x00\x93\x00\xc2\x01\x94\x00\x67\x00\x24\x01\x25\x01\x68\x00\xc3\x01\x6a\x00\xbe\x01\xe3\x02\x4f\x00\x86\x00\x50\x00\xbf\x01\xc0\x01\xf0\x02\x53\x00\xc1\x01\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x9c\x00\xae\x00\xfb\x02\xfc\x02\x6a\x00\xf1\x02\x5f\x00\x4a\x03\x8c\x00\x6a\x00\xc2\x01\xa0\x01\xd1\x01\x62\x00\x63\x00\xd0\x01\x4c\x03\xf4\x02\xa1\x01\x5d\x00\x5e\x00\x36\x02\xf5\x02\x95\x01\x6a\x00\xf0\x00\x4b\x00\x5f\x00\x26\x01\x27\x01\xa2\x01\xf9\x02\x62\x00\x63\x00\xd0\x01\xf6\x02\x68\x00\xc3\x01\x6a\x00\xbe\x01\xf7\x02\x4f\x00\x0a\x03\x50\x00\xbf\x01\xc0\x01\xee\x01\x53\x00\xc1\x01\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xbd\x01\x06\x02\x18\x03\xaa\x00\xe4\x00\xe5\x00\x5f\x00\x0d\x03\xd3\x01\x6a\x00\xc2\x01\xe6\x00\xe7\x00\x07\x02\x0e\x03\x68\x00\xc3\x01\x6a\x00\xbe\x01\x0f\x03\x4f\x00\x10\x03\x50\x00\xbf\x01\xc0\x01\x17\x03\x53\x00\xc1\x01\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x9c\x00\x6f\x03\x32\x00\x33\x00\xf0\x00\x4b\x00\x5f\x00\xa1\x00\x18\x01\x19\x01\xc2\x01\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xa1\x00\x97\x00\x3d\x00\x98\x00\xa2\x00\x4b\x03\x8c\x00\x6a\x00\x2b\x03\xa3\x00\x99\x00\x5d\x00\x5e\x00\xa2\x00\x45\x03\x32\x00\x33\x00\x1f\x03\xa3\x00\x5f\x00\x68\x00\xc3\x01\x6a\x00\xa4\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x1e\x01\x1f\x01\x86\x00\xa4\x00\x23\x03\xc8\x01\x63\x00\xc9\x01\x26\x03\x84\x00\xd7\x00\x86\x00\x10\x03\x32\x00\x33\x00\x24\x01\x25\x01\x77\x02\xa6\x00\xa7\x00\x78\x02\x79\x02\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xe8\x01\x27\x03\x68\x00\xc3\x01\x6a\x00\xf1\x02\x8c\x00\x6a\x00\x26\x01\x27\x01\x8f\x00\x62\x00\x63\x00\xd0\x01\x06\x00\x7c\x02\x07\x00\x7d\x02\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\x9c\x00\x39\x00\xf2\x02\x8c\x00\x6a\x00\x63\x02\x18\x00\x19\x00\x3e\xfe\x3a\x00\x06\x00\xbc\x01\x07\x00\x8c\x02\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\x92\x02\x39\x00\x68\x00\x91\x00\x6a\x00\x86\x01\x18\x00\x19\x00\x06\x00\x3a\x00\x07\x00\x2a\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\x9c\x02\x39\x00\x95\x02\x32\x00\x33\x00\xa1\x00\x18\x00\x19\x00\x9d\x02\x3a\x00\xa5\x02\xa7\x02\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xee\x01\xa2\x00\xca\x00\xb3\x02\xa2\x01\xb4\x02\xa3\x00\xbc\x02\xbd\x02\x9e\x02\xce\x00\xcf\x00\x96\x02\x32\x00\x33\x00\xe5\x01\x62\x00\x63\x00\xd0\x01\xbf\x02\xa4\x00\xc0\x02\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x2a\x02\xce\x00\xcf\x00\x05\x03\xa6\x00\xa7\x00\xcf\x01\x62\x00\x63\x00\xd0\x01\x86\x00\xd1\x02\x97\x02\x32\x00\x33\x00\x66\x01\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x86\x01\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xcb\x00\xd6\x02\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd7\x02\xd2\x00\x62\x00\x63\x00\x64\x00\xd3\x00\x66\x00\x67\x00\x06\x00\x9c\x00\x07\x00\xda\x02\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\x9c\x00\x39\x00\x26\x02\xa6\x00\xa7\x00\xdc\x02\x18\x00\x19\x00\x06\x00\x3a\x00\x07\x00\xdf\x02\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\xdf\x01\x39\x00\x23\x03\xa6\x00\xa7\x00\xe0\x01\x18\x00\x19\x00\x06\x00\x3a\x00\x07\x00\xe5\x01\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\xec\x01\x39\x00\x41\x02\x32\x00\x33\x00\xe4\x01\x18\x00\x19\x00\xee\x01\x3a\x00\xfb\x01\xfc\x01\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x86\x00\x12\x02\xe0\x00\x26\x02\xa6\x00\xa7\x00\xa2\x02\xa6\x00\xa7\x00\x2a\x02\xce\x00\xcf\x00\x52\x02\x32\x00\x33\x00\xcf\x01\x62\x00\x63\x00\xd0\x01\xa3\x02\xa6\x00\xa7\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x7d\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x26\x02\xa6\x00\xa7\x00\xb8\x02\x8c\x00\x6a\x00\x76\x01\x32\x00\x33\x00\xbd\x02\x8c\x00\x6a\x00\xc2\x02\x8c\x00\x6a\x00\xee\x01\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xe1\x00\x19\x02\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x3d\x00\xd2\x00\x62\x00\x63\x00\x64\x00\xe2\x00\x66\x00\x67\x00\x06\x00\x9c\x00\x07\x00\x20\x02\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\xee\x01\x39\x00\xc3\x02\x8c\x00\x6a\x00\x28\x02\x18\x00\x19\x00\x06\x00\x3a\x00\x07\x00\x29\x02\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\x78\x01\x39\x00\xc4\x02\x8c\x00\x6a\x00\xee\x01\x18\x00\x19\x00\x06\x00\x3a\x00\x07\x00\x34\x02\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\x86\x00\x39\x00\xf1\x00\x32\x00\x33\x00\xee\x01\x18\x00\x19\x00\x3a\x02\x3a\x00\x3b\x02\x3c\x02\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x40\x02\x92\x01\xcf\x00\x93\x01\xd1\x00\x9d\x02\x3d\x02\x92\x00\x63\x00\xe9\x01\x3e\x02\x2a\x00\x31\x00\x32\x00\x33\x00\xcf\x01\x62\x00\x63\x00\xd0\x01\xc8\x02\x8c\x00\x6a\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x7d\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\xc9\x02\x8c\x00\x6a\x00\xbc\x01\x54\x02\x06\x00\x46\x02\x07\x00\x57\x02\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\x55\x02\xea\x00\x56\x02\x79\x01\x95\x01\x6a\x00\x18\x00\x19\x00\xcd\x02\x8c\x00\x6a\x00\x58\x02\x59\x02\x06\x00\x9c\x00\x07\x00\x86\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\x64\x02\x39\x00\xd8\x02\xa6\x00\xa7\x00\x66\x02\x18\x00\x19\x00\x06\x00\x3a\x00\x07\x00\x1b\x01\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\x1a\x01\x39\x00\x85\x02\x4a\x02\x1c\x01\x1d\x01\x18\x00\x19\x00\x69\x02\x3a\x00\x06\x02\x6b\x01\xaa\x00\x5d\x01\x5e\x01\x4b\x02\x68\x01\x4f\x00\x86\x00\x50\x00\x4c\x02\x4d\x02\x07\x02\x53\x00\x4e\x02\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xa5\x00\xa6\x00\xa7\x00\x74\x01\xd8\x00\xb9\x00\x5f\x00\xd9\x00\x78\x01\x7c\x01\x4f\x02\xe6\x01\xa6\x00\xa7\x00\xda\x00\x5d\x00\x5e\x00\x73\x01\xe7\x01\xa6\x00\xa7\x00\x7e\x01\x86\x00\x5f\x00\x3d\x00\x88\x01\xba\x00\x3d\x00\x3d\xfe\x06\x00\x6c\x00\x07\x00\x86\x01\xf4\x00\x09\x00\x0a\x00\x49\x01\xf7\x01\x62\x00\x63\x00\xd0\x01\x3d\xfe\x6d\x00\xe5\xff\x86\x01\x06\x00\x3d\xfe\x07\x00\x3d\x00\xf4\x00\x09\x00\x03\x01\xa5\x02\x9e\x01\x18\x00\x19\x00\x8e\x01\xce\x00\xcf\x00\x3d\x00\x3d\xfe\xaa\x00\x8f\x00\x62\x00\x63\x00\xd0\x01\x84\x00\xd7\x00\x86\x00\xc5\x01\x18\x00\x19\x00\x3f\x01\xcd\x01\x68\x00\xc3\x01\x6a\x00\x6e\x00\x6f\x00\x3d\x00\x70\x00\xcf\x01\x71\x00\x2a\x00\x86\x00\x72\x00\xda\x01\xff\xff\x73\x00\x8a\x00\x74\x00\x75\x00\x76\x00\xdd\x00\xa5\x00\xa6\x00\xa7\x00\x77\x00\x78\x00\x8b\x00\x79\x00\x88\x02\x86\x00\x7a\x00\x7b\x00\x8e\x00\x7c\x00\x7d\x00\x86\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xe9\x00\x68\x00\x90\x01\x6a\x00\x3d\x00\xff\xff\x84\x00\x85\x00\x86\x00\x87\x00\x1b\x00\x0e\x02\x8c\x00\x6a\x00\x3f\xfe\xfb\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xea\x00\xed\x00\x23\x00\x26\x02\xa6\x00\xa7\x00\x06\x00\xf3\x00\x07\x00\xf1\x00\xf4\x00\x09\x00\x61\x02\x24\x00\xf4\x00\xcb\x00\xf8\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xfc\x00\xd2\x00\x62\x00\x63\x00\xd0\x01\xfd\x00\x3c\x00\x3d\x00\x18\x00\x19\x00\x25\x00\x3e\x00\x6f\x00\x3f\x00\x70\x00\x40\x00\x71\x00\x3d\xfe\x41\x00\x72\x00\x42\x00\x43\x00\x73\x00\xff\xff\x74\x00\x75\x00\x76\x00\x44\x00\x45\x00\x46\x00\x3d\xfe\x77\x00\x78\x00\xfe\x00\x79\x00\x3d\xfe\x47\x00\x7a\x00\x7b\x00\x26\x00\x7c\x00\x7d\x00\x48\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x3d\xfe\x49\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x4a\x00\x51\x02\x86\x00\x52\x02\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x34\x02\x8c\x00\x6a\x00\xff\x00\x00\x01\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x06\x01\x6f\x00\x23\x00\xff\xff\x17\x01\x06\x00\xa1\x00\x07\x00\x1a\x01\xf4\x00\x09\x00\x0a\x00\x4a\x01\x24\x00\x75\x00\x6f\x01\x8c\x00\x6a\x00\x1b\x01\xa2\x00\x80\x01\x8c\x00\x6a\x00\x79\x00\xa3\x00\x81\x01\x8c\x00\x6a\x00\x1c\x01\x7c\x00\x18\x00\x19\x00\x7e\x00\x25\x00\x80\x00\xd7\xff\x1d\x01\xd7\xff\xa4\x00\xd7\xff\xd7\xff\x00\x00\xd7\xff\x00\x00\x00\x00\xd7\xff\x86\x00\xd7\xff\xd7\xff\xd7\xff\x8b\x01\xa6\x00\xa7\x00\xd7\xff\xd7\xff\xd7\xff\x00\x00\xd7\xff\xd7\xff\x00\x00\xd7\xff\xd7\xff\x26\x00\xd7\xff\xd7\xff\x00\x00\xd7\xff\xd7\xff\xd7\xff\xd7\xff\xd7\xff\xd7\xff\xd7\xff\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xd7\xff\xd7\xff\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\xa5\x00\xa6\x00\xa7\x00\x00\x00\xae\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\xd1\x01\x62\x00\x63\x00\x64\x00\x00\x00\xd2\x01\x67\x00\x3e\x02\x00\x00\x4f\x00\x24\x00\x50\x00\xbf\x01\xc0\x01\x00\x00\x53\x00\xc1\x01\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x8b\x00\x8c\x00\x6a\x00\x25\x00\x00\x00\x6f\x00\x5f\x00\x70\x00\x00\x00\x71\x00\xc2\x01\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa5\x00\xa6\x00\xa7\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\xd3\x01\x6a\x00\x7a\x00\x7b\x00\x26\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x85\x00\x86\x00\x52\x02\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\xb4\x00\x8c\x00\x6a\x00\x00\x00\x59\x02\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x68\x00\xc3\x01\x6a\x00\x8d\x01\x47\x03\xaa\x00\x8d\x01\x09\x03\xaa\x00\x24\x00\x5a\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x8d\x01\xa2\x02\xaa\x00\x8d\x01\xa8\x02\xaa\x00\x00\x00\x00\x00\x92\x01\xcf\x00\x3d\x00\x00\x00\x00\x00\x25\x00\x92\x00\x63\x00\xe9\x01\x70\x00\x01\x02\x71\x00\xaa\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x02\x02\x8d\x01\xce\x01\xaa\x00\x77\x00\x78\x00\x68\x00\x5b\x02\x6a\x00\x00\x00\x7a\x00\x7b\x00\x26\x00\x8a\x02\x7d\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x85\x00\x86\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x95\x01\x6a\x00\x00\x00\x3c\xfe\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x38\x01\x3c\xfe\x39\x01\x00\x00\x3a\x01\x3b\x01\x3c\xfe\x00\x00\x3c\x01\x3d\x01\x24\x00\x00\x00\xe1\x00\x00\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x3c\xfe\xd2\x00\x62\x00\x63\x00\xd0\x01\x00\x00\x84\x00\x00\x00\x86\x00\x00\x00\x25\x00\x8d\x01\xeb\x01\xaa\x00\x70\x00\x65\x01\x71\x00\xaa\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x66\x01\x28\x01\x29\x01\x2a\x01\x77\x00\x78\x00\xa9\x00\xce\x01\xaa\x00\x00\x00\x7a\x00\x7b\x00\x26\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x85\x00\x86\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x28\x01\x29\x01\x2a\x01\x3c\xfe\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x3c\xfe\xae\x00\x00\x00\x00\x00\x00\x00\x3c\xfe\x2b\x02\xce\x00\xcf\x00\x24\x00\x00\x00\x00\x00\xd1\x01\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x06\x00\x3c\xfe\x07\x00\x00\x00\xf4\x00\x09\x00\x46\x01\x3c\x00\x3d\x00\x86\x00\x00\x00\x25\x00\x3e\x00\x00\x00\x3f\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x00\x00\x42\x00\x43\x00\x8e\x00\x00\x00\x18\x00\x19\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x00\x00\x8f\x00\x62\x00\x63\x00\x64\x00\x47\x00\x90\x00\x67\x00\x26\x00\x00\x00\x00\x00\x48\x00\x00\x00\x00\x00\x01\x02\x00\x00\xaa\x00\x06\x03\x6a\x00\x49\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x4a\x00\x4b\x00\x02\x02\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xbb\x02\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x00\x91\x00\x6a\x00\x00\x00\x24\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x25\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\xa1\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x9e\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa2\x00\x65\x01\x00\x00\xaa\x00\x00\x00\xa3\x00\x84\x00\x9f\x00\x86\x00\x26\x00\x3c\xfe\x00\x00\x06\x00\x66\x01\x07\x00\x00\x00\xf4\x00\x09\x00\x47\x01\xa4\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x86\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x00\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x16\x02\x00\x00\x00\x00\x23\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x24\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x25\x00\xb3\x00\x00\x00\x81\x00\x82\x00\x83\x00\xa4\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x02\xa2\x00\xaa\x00\x00\x00\x25\x02\x00\x00\xa3\x00\xa1\x02\x00\x00\x00\x00\x26\x00\x3d\xfe\x02\x02\x92\x00\x63\x00\x93\x00\x26\x02\x94\x00\x67\x00\xf7\x01\xa4\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x86\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xaf\x01\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\xa1\x00\x06\x00\x00\x00\x07\x00\xa1\x00\x06\x01\x09\x00\xa1\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x95\x00\x6a\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\xa2\x00\x00\x00\xa3\x00\x00\x00\x00\x00\xa3\x00\x18\x00\x19\x00\x25\x00\x06\x00\x00\x00\x07\x00\xa4\x00\x08\x01\x09\x00\x3d\xfe\xa4\x00\x00\x00\x84\x00\xa4\x00\x86\x00\x00\x00\x84\x00\xd7\x00\x86\x00\x84\x00\xd7\x00\x86\x00\x3d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x18\x00\x19\x00\x00\x00\x26\x00\xb0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2f\x02\x86\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x00\x00\x75\x02\x00\x00\xd6\x00\x76\x02\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x4b\x01\x1b\x00\x24\x00\x75\x02\x00\x00\x00\x00\x76\x02\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x18\x00\x19\x00\x77\x02\x66\x03\xa1\x00\x25\x00\x00\x00\x06\x00\x00\x00\x07\x00\x24\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x4d\x01\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x02\x34\x03\x00\x00\x25\x00\x00\x00\x18\x00\x19\x00\x26\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xd7\x00\x86\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x4a\x00\x4b\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x26\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x51\x01\x27\x00\x28\x00\x29\x00\x2a\x00\x4a\x00\x4b\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x11\x02\x00\x00\x00\x00\x23\x00\x00\x00\x92\x01\xcf\x00\x93\x01\xd1\x00\x22\x02\x00\x00\x92\x00\x63\x00\x93\x00\x24\x00\x94\x00\x67\x00\x06\x00\x1b\x00\x07\x00\x75\x02\x0b\x01\x09\x00\x76\x02\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\xfe\x18\x00\x19\x00\x24\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x48\x01\x00\x00\x3c\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x3c\xfe\x00\x00\x77\x02\x00\x00\x26\x00\x25\x00\x95\x01\x6a\x00\x00\x00\x65\x01\x00\x00\xaa\x00\x18\x00\x19\x00\x3c\xfe\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x66\x01\x86\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x52\x01\x27\x00\x28\x00\x29\x00\x2a\x00\x4a\x00\x4b\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x18\x00\x19\x00\xa1\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x06\x00\x00\x00\x07\x00\x24\x00\xf4\x00\x09\x00\x03\x01\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x86\x00\x00\x00\x23\x00\x25\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\xa1\x00\x00\x00\x06\x00\x24\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x4e\x01\x00\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x77\x02\x00\x00\x26\x00\x25\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x00\x00\xa2\x01\x00\x00\x00\x00\x00\x00\x26\x00\x9e\x02\xce\x00\xcf\x00\x9f\x02\xd1\x00\x00\x00\xe5\x01\x62\x00\x63\x00\xd0\x01\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xcb\x01\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\xe6\x02\x00\x00\x00\x00\xcc\x01\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x4c\x01\x1b\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x9c\x00\x00\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\xa1\x00\x25\x00\x00\x00\x06\x00\x00\x00\x07\x00\x24\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x4f\x01\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x02\x00\x00\x00\x00\x25\x00\x00\x00\x18\x00\x19\x00\x26\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x00\x00\x86\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x26\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x50\x01\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x92\x01\xcf\x00\x93\x01\xd1\x00\x22\x02\x00\x00\x92\x00\x63\x00\xe9\x01\x00\x00\x24\x00\x1b\x00\x45\x01\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x63\x02\x00\x00\x06\x00\x25\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x2a\x01\x00\x00\x24\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x18\x00\x19\x00\x00\x00\x25\x00\x00\x00\x26\x00\x95\x01\x6a\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x59\x01\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x25\x00\x00\x00\x26\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x0c\x01\x09\x00\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x00\x00\x00\x00\x26\x00\x18\x00\x19\x00\x92\x01\xcf\x00\x93\x01\xd1\x00\x29\x02\x00\x00\x92\x00\x63\x00\xe9\x01\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x95\x01\x6a\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x25\x00\xd1\x02\x00\x00\x00\x00\x26\x00\x8e\x01\xce\x00\xcf\x00\x8f\x01\xd1\x00\x24\x00\x8f\x00\x62\x00\x63\x00\xd0\x01\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x26\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x00\x90\x01\x6a\x00\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x08\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x92\x01\xcf\x00\x93\x01\xd1\x00\x07\x03\x00\x00\x92\x00\x63\x00\xe9\x01\x0a\x01\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x25\x00\x00\x00\x00\x00\x00\x00\x26\x00\x95\x01\x6a\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x26\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x01\x00\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x66\x01\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x6d\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x3d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x00\x00\x00\x00\x00\x00\x24\x00\x6e\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x3d\xfe\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x86\x00\x00\x00\x25\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x06\x02\x00\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x84\x00\x85\x00\x86\x00\x87\x00\x26\x00\x00\x00\x07\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x2d\x01\x2e\x01\x2f\x01\x30\x01\x31\x01\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x00\x00\x01\x02\x6f\x00\xaa\x00\x70\x00\x00\x00\x71\x00\x3d\xfe\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x02\x02\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x77\x00\x78\x00\x00\x00\x79\x00\x3d\xfe\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x3d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x85\x00\x86\x00\x01\x02\x6f\x00\xaa\x00\x70\x00\x00\x00\x71\x00\x3d\xfe\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x02\x02\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x77\x00\x78\x00\x00\x00\x79\x00\x3d\xfe\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x3d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x85\x00\x86\x00\x01\x02\x6f\x00\xaa\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x02\x02\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xb3\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xb4\x00\x86\x00\xcb\x01\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\xcc\x01\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xdf\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xe0\x00\x86\x00\xcb\x01\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\xcc\x01\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xa6\x01\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xa7\x01\x86\x00\xcb\x01\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\xcc\x01\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xb3\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xb4\x00\x86\x00\xcb\x01\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\xcc\x01\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xdf\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xe0\x00\x86\x00\xcb\x01\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\xcc\x01\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xa6\x01\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xa7\x01\x86\x00\xcb\x01\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\xcc\x01\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xb3\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xb4\x00\x86\x00\x65\x01\x6f\x00\xaa\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x66\x01\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xdf\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xe0\x00\x86\x00\x6c\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x3d\xfe\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x6d\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x77\x00\x78\x00\x00\x00\x79\x00\x3d\xfe\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x3d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x86\x00\x6c\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x6d\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xa6\x01\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xa7\x01\x86\x00\x6c\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x6d\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xb3\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xb4\x00\x86\x00\x06\x02\x6f\x00\xaa\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x07\x02\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xdf\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\xe0\x00\x86\x00\x65\x01\x6f\x00\xaa\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x66\x01\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x9e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\xcb\x01\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x9f\x00\x86\x00\x00\x00\x6f\x00\x00\x00\x70\x00\xcc\x01\x71\x00\x00\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x9e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\x6c\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x9f\x00\x86\x00\x72\x00\x00\x00\x00\x00\x73\x00\x6d\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x9e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x84\x00\x9f\x00\x86\x00\x00\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x00\x00\x6d\x00\x72\x00\x00\x00\xcb\x01\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\xcc\x01\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x9e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x01\x02\xfb\x02\xaa\x00\x00\x00\x00\x00\x00\x00\x84\x00\x9f\x00\x86\x00\x00\x00\xa1\x00\x00\x00\x02\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\xa2\x00\x71\x00\x00\x00\x00\x00\x72\x00\xa3\x00\x00\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x84\x00\x7d\x00\x86\x00\x00\x00\x9e\x00\x3d\xfe\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x9f\x00\x86\x00\x3d\xfe\x00\x00\x00\x00\xb0\x01\xb1\x01\x3d\xfe\x53\x00\xb2\x01\x55\x00\x56\x00\x57\x00\xb3\x01\xb4\x01\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x00\x00\x3d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x84\x00\x00\x00\x86\x00\xb5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x92\x01\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\x00\x63\x00\xe9\x01\x00\x00\x00\x00\x00\x00\xb6\x01\xb7\x01\xb8\x01\x00\x00\x00\x00\x00\x00\x5c\x02\xa6\x00\xa7\x00\x5d\x02\x5e\x02\x00\x00\x00\x00\x00\x00\xb0\x01\xb1\x01\x00\x00\x53\x00\xb2\x01\x55\x00\x56\x00\x57\x00\xb3\x01\xb4\x01\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x00\x00\x92\x01\xcf\x00\x93\x01\xd1\x00\x29\x02\x5f\x00\x92\x00\x63\x00\x93\x00\xb5\x01\x94\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x00\xc7\x02\x6a\x00\x92\x00\x63\x00\xe9\x01\x00\x00\x00\x00\x00\x00\xb6\x01\xb7\x01\xb8\x01\x00\x00\x00\x00\x00\x00\x5c\x02\xa6\x00\xa7\x00\x5d\x02\x5e\x02\xb0\x01\xb1\x01\x00\x00\x53\x00\xb2\x01\x55\x00\x56\x00\x57\x00\xb3\x01\xb4\x01\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x95\x01\x6a\x00\xb5\x01\x92\x01\xcf\x00\x93\x01\xd1\x00\x94\x01\x00\x00\x92\x00\x63\x00\xe9\x01\x00\x00\x68\x00\xcc\x02\x6a\x00\x00\x00\x00\x00\x00\x00\xb6\x01\xb7\x01\xb8\x01\x00\x00\x00\x00\x00\x00\x5c\x02\xa6\x00\xa7\x00\x5d\x02\x5e\x02\xb0\x01\xb1\x01\x00\x00\x53\x00\xb2\x01\x55\x00\x56\x00\x57\x00\xb3\x01\xb4\x01\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x00\x00\x92\x01\xcf\x00\x93\x01\xd1\x00\x94\x01\x5f\x00\x92\x00\x63\x00\x93\x00\xb5\x01\x94\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x95\x01\x6a\x00\x00\x00\x68\x00\x5f\x02\x6a\x00\x00\x00\x00\x00\x00\x00\xb6\x01\xb7\x01\xb8\x01\xb9\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x01\xb1\x01\x00\x00\x53\x00\xb2\x01\x55\x00\x56\x00\x57\x00\xb3\x01\xb4\x01\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\xb5\x01\x95\x01\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x00\xba\x01\x6a\x00\xb6\x01\xb7\x01\xb8\x01\x00\x00\x00\x00\x00\x00\xb0\x01\xb1\x01\x00\x00\x53\x00\xb2\x01\x55\x00\x56\x00\x57\x00\xb3\x01\xb4\x01\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x00\x00\xd8\x00\xb9\x00\x00\x00\xd9\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\xb5\x01\xda\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\xab\x00\xba\x00\xac\x00\x00\x00\x68\x00\xba\x01\x6a\x00\xce\x02\x00\x00\xad\x00\x5d\x00\x5e\x00\x07\x02\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\xae\x00\x00\x00\x00\x00\x08\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x00\x00\x00\x00\xfc\x01\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x01\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x00\x00\x00\x00\x68\x00\xba\x01\x6a\x00\x00\x00\x97\x00\x00\x00\x98\x00\x00\x00\xab\x00\x00\x00\xac\x00\x00\x00\x00\x00\x99\x00\x5d\x00\x5e\x00\xdd\x00\xad\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\xae\x00\x00\x00\x23\x02\xcf\x00\x00\x00\x00\x00\xfe\x01\xff\x01\xc8\x01\x63\x00\xc9\x01\xf2\x01\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x02\xa6\x00\xa7\x00\x78\x02\x79\x02\x97\x00\x00\x00\x98\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x9f\x01\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x97\x00\x00\x00\x98\x00\xa1\x01\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x99\x00\x5d\x00\x5e\x00\x5f\x00\x9c\x00\x00\x00\xa2\x01\xf3\x01\x6a\x00\x5f\x00\x00\x00\x77\x02\xa6\x00\xa7\x00\x78\x02\x79\x02\x00\x00\xd4\x02\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\xf1\x01\x62\x00\x63\x00\xd0\x01\x0e\x01\x55\x00\x00\x00\x0f\x01\x00\x00\x10\x01\x00\x00\x11\x01\x5c\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x01\x55\x00\x5f\x00\x0f\x01\x00\x00\x10\x01\x12\x01\x11\x01\x5c\x00\x5d\x00\x5e\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x12\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x02\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x06\x00\x81\x02\x07\x00\x00\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\x00\x00\xb7\x02\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x68\x00\x15\x01\x6a\x00\x0e\x01\x55\x00\x00\x00\x0f\x01\x00\x00\x10\x01\x00\x00\x11\x01\x5c\x00\x5d\x00\x5e\x00\x00\x00\x68\x00\x15\x01\x6a\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x12\x01\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x55\x01\x0e\x01\x55\x00\x00\x00\x0f\x01\x00\x00\x10\x01\xef\x01\x11\x01\x5c\x00\x5d\x00\x5e\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x06\x00\x12\x01\x07\x00\x00\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\x00\x00\xf0\x01\x00\x00\x1c\x02\x00\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x68\x00\x15\x01\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x1d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x68\x00\x15\x01\x6a\x00\x0e\x01\x55\x00\x00\x00\x0f\x01\x00\x00\x10\x01\x00\x00\x11\x01\x5c\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x12\x01\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x54\x01\x00\x00\x0e\x01\x55\x00\x00\x00\x0f\x01\x00\x00\x10\x01\x31\x02\x11\x01\x5c\x00\x5d\x00\x5e\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x06\x00\x12\x01\x07\x00\x00\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\x00\x00\x32\x02\x00\x00\xd7\x01\x00\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x68\x00\x15\x01\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\xd8\x01\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x68\x00\x15\x01\x6a\x00\xa9\x02\x55\x00\x00\x00\x0f\x01\x00\x00\x10\x01\x00\x00\x11\x01\x5c\x00\x5d\x00\x5e\x00\x00\x00\xf7\x02\xab\x02\xac\x02\xa9\x02\x55\x00\x5f\x00\x0f\x01\x00\x00\x10\x01\xad\x02\x11\x01\x5c\x00\x5d\x00\x5e\x00\x00\x00\xaa\x02\xab\x02\xac\x02\x0e\x01\x55\x00\x5f\x00\x0f\x01\x00\x00\x10\x01\xad\x02\x11\x01\x5c\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x0e\x01\x55\x00\x12\x01\x0f\x01\x00\x00\x10\x01\x00\x00\x11\x01\x5c\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x12\x01\x00\x00\x84\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\x68\x00\xae\x02\x6a\x00\x00\x00\x0e\x01\x55\x00\x6d\x01\x0f\x01\x00\x00\x10\x01\x00\x00\x11\x01\x5c\x00\x5d\x00\x5e\x00\x68\x00\xae\x02\x6a\x00\x00\x00\xac\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x12\x01\xad\x00\x5d\x00\x5e\x00\xae\x00\x68\x00\x15\x01\x6a\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\xae\x00\x00\x00\xd1\x01\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x6e\x01\x00\x00\x00\x00\x68\x00\x15\x01\x6a\x00\x7e\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x00\x00\x00\x00\x00\x00\x5e\x01\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x98\x00\x00\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x99\x00\x5d\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x02\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x00\x15\x01\x6a\x00\x00\x00\x00\x00\x7f\x02\xec\x02\x6a\x00\xf9\x02\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x00\x00\x62\x01\x63\x01\x06\x00\x00\x00\x07\x00\x00\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\xab\x01\xa2\x01\x00\x00\x00\x00\x00\x00\x12\x02\x00\x00\x18\x00\x19\x00\x00\x00\x8d\x01\x13\x02\x14\x02\x6a\x00\x8e\x01\xce\x00\xcf\x00\x8f\x01\xd1\x00\x00\x00\x8f\x00\x62\x00\x63\x00\x64\x00\x00\x00\x90\x00\x67\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\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\xab\x01\xaa\x01\x00\x00\x00\x00\xae\x00\xb9\x02\x00\x00\x18\x00\x19\x00\x2b\x02\xce\x00\xcf\x00\x00\x00\x9c\x00\x00\x00\xd1\x01\x62\x00\x63\x00\xd0\x01\x68\x00\x90\x01\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\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\xab\x01\x00\x00\x00\x00\x00\x00\x00\x00\xac\x01\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x68\x00\xad\x01\x6a\x00\xc5\x02\x7f\x02\xed\x02\x6a\x00\x8e\x01\xce\x00\xcf\x00\xca\x02\x9f\x00\x00\x00\x8f\x00\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x00\x00\x8f\x00\x62\x00\x63\x00\xd0\x01\x00\x00\x5a\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x00\x00\x5a\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\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\xc0\x02\x00\x00\x68\x00\xc6\x02\x6a\x00\x00\x00\x00\x00\x18\x00\x19\x00\x68\x00\xcb\x02\x6a\x00\xb0\x02\x00\x00\x05\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\xb0\x02\x00\x00\xb1\x02\x00\x00\x00\x00\x85\x00\x86\x00\xb2\x02\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\xc0\x00\x7f\x00\x00\x00\x81\x00\x82\x00\x83\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\x00\x00\x85\x00\x86\x00\xb2\x02\xc3\x00\x00\x00\x00\x00\x75\x00\x00\x00\x00\x00\x6f\x00\x00\x00\xa2\x00\x00\x00\x00\x00\xa1\x00\x79\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x75\x00\x00\x00\x7e\x00\x00\x00\x80\x00\xa2\x00\x00\x00\x00\x00\xa4\x00\x79\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x86\x00\x00\x00\x7e\x00\x00\x00\x80\x00\x3d\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x00\x00\x86\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x02\x85\x00\x86\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x86\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x3d\xfe\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x77\x00\x78\x00\x00\x00\x79\x00\x3d\xfe\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x3d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x01\x85\x00\x86\x00\x3b\xfe\x00\x00\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x00\x00\x3b\xfe\x00\x00\x00\x00\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x3b\xfe\x00\x00\x00\x00\x00\x00\x3b\xfe\x3b\xfe\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x3b\xfe\x3b\xfe\x3b\xfe\x3b\xfe\x3b\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\xfe\x3b\xfe\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\xa6\x01\x80\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x01\x86\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x3d\xfe\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x77\x00\x78\x00\x00\x00\x79\x00\x3d\xfe\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x3d\xfe\x00\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x85\x00\x86\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x9e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x9f\x00\x86\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x79\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x86\x00\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x00\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x79\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x7e\x00\x00\x00\x80\x00\x00\x00\x82\x00\x83\x00\xa4\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x00\x00\x86\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x81\x00\x82\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x86\x00\xb2\x02\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x00\x00\x00\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\xa6\x01\x00\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\xa7\x01\x86\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x00\x00\x3b\xfe\xb4\x00\x86\x00\x3b\xfe\x00\x00\x3b\xfe\x00\x00\x3b\xfe\x00\x00\x00\x00\x00\x00\x3b\xfe\x3b\xfe\x3b\xfe\x00\x00\x00\x00\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x00\x00\x00\x00\x3b\xfe\x00\x00\x00\x00\x3b\xfe\x00\x00\x3b\xfe\x3b\xfe\x3b\xfe\x3b\xfe\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x3b\xfe\x3b\xfe\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\xa6\x01\x00\x00\x81\x00\x82\x00\x83\x00\xa4\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\xa7\x01\x86\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x81\x00\x82\x00\x83\x00\x00\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x85\x00\x86\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x81\x00\x82\x00\x83\x00\x00\x00\x70\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x9f\x00\x86\x00\x73\x00\x00\x00\x74\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x81\x00\x82\x00\x83\x00\x00\x00\x70\x00\x00\x00\x71\x00\xa1\x00\x00\x00\x72\x00\x85\x00\x86\x00\x73\x00\x00\x00\x00\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x77\x00\x78\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x7a\x00\x7b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x83\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x02\x86\x00\x27\x03\x6e\x02\x6f\x02\x70\x02\x71\x02\x06\x00\x00\x00\x07\x00\x00\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\x72\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x6c\x02\x73\x02\x6d\x02\x6e\x02\x6f\x02\x70\x02\x71\x02\x06\x00\x00\x00\x07\x00\x00\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\x72\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x31\x03\x73\x02\x00\x00\x32\x03\x6f\x02\x70\x02\x71\x02\x06\x00\x00\x00\x07\x00\x00\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\x72\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x73\x02\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x02\x18\x00\x19\x00\x00\x00\x67\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x02\x06\x00\x00\x00\x07\x00\x00\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\x72\x02\x00\x00\x2e\x03\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x72\x02\x00\x00\xd7\x02\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x72\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\xab\x01\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x02\x00\x00\x18\x00\x19\x00\x00\x00\x06\x00\x00\x00\x07\x00\x9c\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\x00\x00\xea\x00\x00\x00\x43\x03\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\xea\x00\x00\x00\x44\x03\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\xea\x00\x00\x00\x93\x02\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\xea\x00\x00\x00\x94\x02\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\xea\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x77\x03\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x78\x03\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x61\x03\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x3a\x03\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x92\x02\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x41\x01\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x42\x01\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\x43\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x57\x01\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x5a\x01\x00\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x7a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x7c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x7e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x7f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x03\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x03\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x03\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x66\x03\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x03\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x03\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x51\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x02\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\xee\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x29\x03\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x69\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x6b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x02\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x45\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\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\x6c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\xf5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\x6a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\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\x64\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x59\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x56\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf4\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x53\x01\x02\x02\xce\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x03\x02\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x04\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x09\x02\xce\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x0a\x02\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x03\x0b\x02\x5f\x01\xa6\x00\xa7\x00\x60\x01\x61\x01\x02\x03\x00\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x01\x03\xf4\x01\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x02\x03\x00\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x00\x00\xf4\x01\x62\x00\x63\x00\xd0\x01\xcb\x00\x00\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x00\x00\xf4\x01\x62\x00\x63\x00\xd0\x01\xe1\x00\x00\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x00\x00\xf4\x01\x62\x00\x63\x00\xd0\x01\x37\x02\x00\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x00\x00\xf4\x01\x62\x00\x63\x00\xd0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyReduceArr = array (4, 463) [ (4 , happyReduce_4), (5 , happyReduce_5), (6 , happyReduce_6), (7 , happyReduce_7), (8 , happyReduce_8), (9 , happyReduce_9), (10 , happyReduce_10), (11 , happyReduce_11), (12 , happyReduce_12), (13 , happyReduce_13), (14 , happyReduce_14), (15 , happyReduce_15), (16 , happyReduce_16), (17 , happyReduce_17), (18 , happyReduce_18), (19 , happyReduce_19), (20 , happyReduce_20), (21 , happyReduce_21), (22 , happyReduce_22), (23 , happyReduce_23), (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), (112 , happyReduce_112), (113 , happyReduce_113), (114 , happyReduce_114), (115 , happyReduce_115), (116 , happyReduce_116), (117 , happyReduce_117), (118 , happyReduce_118), (119 , happyReduce_119), (120 , happyReduce_120), (121 , happyReduce_121), (122 , happyReduce_122), (123 , happyReduce_123), (124 , happyReduce_124), (125 , happyReduce_125), (126 , happyReduce_126), (127 , happyReduce_127), (128 , happyReduce_128), (129 , happyReduce_129), (130 , happyReduce_130), (131 , happyReduce_131), (132 , happyReduce_132), (133 , happyReduce_133), (134 , happyReduce_134), (135 , happyReduce_135), (136 , happyReduce_136), (137 , happyReduce_137), (138 , happyReduce_138), (139 , happyReduce_139), (140 , happyReduce_140), (141 , happyReduce_141), (142 , happyReduce_142), (143 , happyReduce_143), (144 , happyReduce_144), (145 , happyReduce_145), (146 , happyReduce_146), (147 , happyReduce_147), (148 , happyReduce_148), (149 , happyReduce_149), (150 , happyReduce_150), (151 , happyReduce_151), (152 , happyReduce_152), (153 , happyReduce_153), (154 , happyReduce_154), (155 , happyReduce_155), (156 , happyReduce_156), (157 , happyReduce_157), (158 , happyReduce_158), (159 , happyReduce_159), (160 , happyReduce_160), (161 , happyReduce_161), (162 , happyReduce_162), (163 , happyReduce_163), (164 , happyReduce_164), (165 , happyReduce_165), (166 , happyReduce_166), (167 , happyReduce_167), (168 , happyReduce_168), (169 , happyReduce_169), (170 , happyReduce_170), (171 , happyReduce_171), (172 , happyReduce_172), (173 , happyReduce_173), (174 , happyReduce_174), (175 , happyReduce_175), (176 , happyReduce_176), (177 , happyReduce_177), (178 , happyReduce_178), (179 , happyReduce_179), (180 , happyReduce_180), (181 , happyReduce_181), (182 , happyReduce_182), (183 , happyReduce_183), (184 , happyReduce_184), (185 , happyReduce_185), (186 , happyReduce_186), (187 , happyReduce_187), (188 , happyReduce_188), (189 , happyReduce_189), (190 , happyReduce_190), (191 , happyReduce_191), (192 , happyReduce_192), (193 , happyReduce_193), (194 , happyReduce_194), (195 , happyReduce_195), (196 , happyReduce_196), (197 , happyReduce_197), (198 , happyReduce_198), (199 , happyReduce_199), (200 , happyReduce_200), (201 , happyReduce_201), (202 , happyReduce_202), (203 , happyReduce_203), (204 , happyReduce_204), (205 , happyReduce_205), (206 , happyReduce_206), (207 , happyReduce_207), (208 , happyReduce_208), (209 , happyReduce_209), (210 , happyReduce_210), (211 , happyReduce_211), (212 , happyReduce_212), (213 , happyReduce_213), (214 , happyReduce_214), (215 , happyReduce_215), (216 , happyReduce_216), (217 , happyReduce_217), (218 , happyReduce_218), (219 , happyReduce_219), (220 , happyReduce_220), (221 , happyReduce_221), (222 , happyReduce_222), (223 , happyReduce_223), (224 , happyReduce_224), (225 , happyReduce_225), (226 , happyReduce_226), (227 , happyReduce_227), (228 , happyReduce_228), (229 , happyReduce_229), (230 , happyReduce_230), (231 , happyReduce_231), (232 , happyReduce_232), (233 , happyReduce_233), (234 , happyReduce_234), (235 , happyReduce_235), (236 , happyReduce_236), (237 , happyReduce_237), (238 , happyReduce_238), (239 , happyReduce_239), (240 , happyReduce_240), (241 , happyReduce_241), (242 , happyReduce_242), (243 , happyReduce_243), (244 , happyReduce_244), (245 , happyReduce_245), (246 , happyReduce_246), (247 , happyReduce_247), (248 , happyReduce_248), (249 , happyReduce_249), (250 , happyReduce_250), (251 , happyReduce_251), (252 , happyReduce_252), (253 , happyReduce_253), (254 , happyReduce_254), (255 , happyReduce_255), (256 , happyReduce_256), (257 , happyReduce_257), (258 , happyReduce_258), (259 , happyReduce_259), (260 , happyReduce_260), (261 , happyReduce_261), (262 , happyReduce_262), (263 , happyReduce_263), (264 , happyReduce_264), (265 , happyReduce_265), (266 , happyReduce_266), (267 , happyReduce_267), (268 , happyReduce_268), (269 , happyReduce_269), (270 , happyReduce_270), (271 , happyReduce_271), (272 , happyReduce_272), (273 , happyReduce_273), (274 , happyReduce_274), (275 , happyReduce_275), (276 , happyReduce_276), (277 , happyReduce_277), (278 , happyReduce_278), (279 , happyReduce_279), (280 , happyReduce_280), (281 , happyReduce_281), (282 , happyReduce_282), (283 , happyReduce_283), (284 , happyReduce_284), (285 , happyReduce_285), (286 , happyReduce_286), (287 , happyReduce_287), (288 , happyReduce_288), (289 , happyReduce_289), (290 , happyReduce_290), (291 , happyReduce_291), (292 , happyReduce_292), (293 , happyReduce_293), (294 , happyReduce_294), (295 , happyReduce_295), (296 , happyReduce_296), (297 , happyReduce_297), (298 , happyReduce_298), (299 , happyReduce_299), (300 , happyReduce_300), (301 , happyReduce_301), (302 , happyReduce_302), (303 , happyReduce_303), (304 , happyReduce_304), (305 , happyReduce_305), (306 , happyReduce_306), (307 , happyReduce_307), (308 , happyReduce_308), (309 , happyReduce_309), (310 , happyReduce_310), (311 , happyReduce_311), (312 , happyReduce_312), (313 , happyReduce_313), (314 , happyReduce_314), (315 , happyReduce_315), (316 , happyReduce_316), (317 , happyReduce_317), (318 , happyReduce_318), (319 , happyReduce_319), (320 , happyReduce_320), (321 , happyReduce_321), (322 , happyReduce_322), (323 , happyReduce_323), (324 , happyReduce_324), (325 , happyReduce_325), (326 , happyReduce_326), (327 , happyReduce_327), (328 , happyReduce_328), (329 , happyReduce_329), (330 , happyReduce_330), (331 , happyReduce_331), (332 , happyReduce_332), (333 , happyReduce_333), (334 , happyReduce_334), (335 , happyReduce_335), (336 , happyReduce_336), (337 , happyReduce_337), (338 , happyReduce_338), (339 , happyReduce_339), (340 , happyReduce_340), (341 , happyReduce_341), (342 , happyReduce_342), (343 , happyReduce_343), (344 , happyReduce_344), (345 , happyReduce_345), (346 , happyReduce_346), (347 , happyReduce_347), (348 , happyReduce_348), (349 , happyReduce_349), (350 , happyReduce_350), (351 , happyReduce_351), (352 , happyReduce_352), (353 , happyReduce_353), (354 , happyReduce_354), (355 , happyReduce_355), (356 , happyReduce_356), (357 , happyReduce_357), (358 , happyReduce_358), (359 , happyReduce_359), (360 , happyReduce_360), (361 , happyReduce_361), (362 , happyReduce_362), (363 , happyReduce_363), (364 , happyReduce_364), (365 , happyReduce_365), (366 , happyReduce_366), (367 , happyReduce_367), (368 , happyReduce_368), (369 , happyReduce_369), (370 , happyReduce_370), (371 , happyReduce_371), (372 , happyReduce_372), (373 , happyReduce_373), (374 , happyReduce_374), (375 , happyReduce_375), (376 , happyReduce_376), (377 , happyReduce_377), (378 , happyReduce_378), (379 , happyReduce_379), (380 , happyReduce_380), (381 , happyReduce_381), (382 , happyReduce_382), (383 , happyReduce_383), (384 , happyReduce_384), (385 , happyReduce_385), (386 , happyReduce_386), (387 , happyReduce_387), (388 , happyReduce_388), (389 , happyReduce_389), (390 , happyReduce_390), (391 , happyReduce_391), (392 , happyReduce_392), (393 , happyReduce_393), (394 , happyReduce_394), (395 , happyReduce_395), (396 , happyReduce_396), (397 , happyReduce_397), (398 , happyReduce_398), (399 , happyReduce_399), (400 , happyReduce_400), (401 , happyReduce_401), (402 , happyReduce_402), (403 , happyReduce_403), (404 , happyReduce_404), (405 , happyReduce_405), (406 , happyReduce_406), (407 , happyReduce_407), (408 , happyReduce_408), (409 , happyReduce_409), (410 , happyReduce_410), (411 , happyReduce_411), (412 , happyReduce_412), (413 , happyReduce_413), (414 , happyReduce_414), (415 , happyReduce_415), (416 , happyReduce_416), (417 , happyReduce_417), (418 , happyReduce_418), (419 , happyReduce_419), (420 , happyReduce_420), (421 , happyReduce_421), (422 , happyReduce_422), (423 , happyReduce_423), (424 , happyReduce_424), (425 , happyReduce_425), (426 , happyReduce_426), (427 , happyReduce_427), (428 , happyReduce_428), (429 , happyReduce_429), (430 , happyReduce_430), (431 , happyReduce_431), (432 , happyReduce_432), (433 , happyReduce_433), (434 , happyReduce_434), (435 , happyReduce_435), (436 , happyReduce_436), (437 , happyReduce_437), (438 , happyReduce_438), (439 , happyReduce_439), (440 , happyReduce_440), (441 , happyReduce_441), (442 , happyReduce_442), (443 , happyReduce_443), (444 , happyReduce_444), (445 , happyReduce_445), (446 , happyReduce_446), (447 , happyReduce_447), (448 , happyReduce_448), (449 , happyReduce_449), (450 , happyReduce_450), (451 , happyReduce_451), (452 , happyReduce_452), (453 , happyReduce_453), (454 , happyReduce_454), (455 , happyReduce_455), (456 , happyReduce_456), (457 , happyReduce_457), (458 , happyReduce_458), (459 , happyReduce_459), (460 , happyReduce_460), (461 , happyReduce_461), (462 , happyReduce_462), (463 , happyReduce_463) ] happy_n_terms = 102 :: Int happy_n_nonterms = 125 :: Int happyReduce_4 = happyMonadReduce 1# 0# happyReduction_4 happyReduction_4 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut8 happy_x_1 of { happy_var_1 -> ( let decls = reverse happy_var_1 in case decls of [] -> do{ n <- getNewName; p <- getCurrentPosition; return $ CTranslUnit decls (mkNodeInfo' p (p,0) n) } (d:ds) -> withNodeInfo d $ CTranslUnit decls)} ) (\r -> happyReturn (happyIn7 r)) happyReduce_5 = happySpecReduce_0 1# happyReduction_5 happyReduction_5 = happyIn8 (empty ) happyReduce_6 = happySpecReduce_2 1# happyReduction_6 happyReduction_6 happy_x_2 happy_x_1 = case happyOut8 happy_x_1 of { happy_var_1 -> happyIn8 (happy_var_1 )} happyReduce_7 = happySpecReduce_2 1# happyReduction_7 happyReduction_7 happy_x_2 happy_x_1 = case happyOut8 happy_x_1 of { happy_var_1 -> case happyOut9 happy_x_2 of { happy_var_2 -> happyIn8 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_8 = happySpecReduce_1 2# happyReduction_8 happyReduction_8 happy_x_1 = case happyOut10 happy_x_1 of { happy_var_1 -> happyIn9 (CFDefExt happy_var_1 )} happyReduce_9 = happySpecReduce_1 2# happyReduction_9 happyReduction_9 happy_x_1 = case happyOut32 happy_x_1 of { happy_var_1 -> happyIn9 (CDeclExt happy_var_1 )} happyReduce_10 = happySpecReduce_2 2# happyReduction_10 happyReduction_10 happy_x_2 happy_x_1 = case happyOut9 happy_x_2 of { happy_var_2 -> happyIn9 (happy_var_2 )} happyReduce_11 = happyMonadReduce 5# 2# happyReduction_11 happyReduction_11 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut123 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CAsmExt happy_var_3)}} ) (\r -> happyReturn (happyIn9 r)) happyReduce_12 = happyMonadReduce 2# 3# happyReduction_12 happyReduction_12 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut11 happy_x_1 of { happy_var_1 -> case happyOut14 happy_x_2 of { happy_var_2 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef [] happy_var_1 [] happy_var_2))}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_13 = happyMonadReduce 3# 3# happyReduction_13 happyReduction_13 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef (liftCAttrs happy_var_1) happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_14 = happyMonadReduce 3# 3# happyReduction_14 happyReduction_14 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef happy_var_1 happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_15 = happyMonadReduce 3# 3# happyReduction_15 happyReduction_15 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef happy_var_1 happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_16 = happyMonadReduce 3# 3# happyReduction_16 happyReduction_16 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef (reverse happy_var_1) happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_17 = happyMonadReduce 3# 3# happyReduction_17 happyReduction_17 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef (liftTypeQuals happy_var_1) happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_18 = happyMonadReduce 4# 3# happyReduction_18 happyReduction_18 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut11 happy_x_3 of { happy_var_3 -> case happyOut14 happy_x_4 of { happy_var_4 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef (liftTypeQuals happy_var_1 ++ liftCAttrs happy_var_2) happy_var_3 [] happy_var_4))}}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_19 = happyMonadReduce 3# 3# happyReduction_19 happyReduction_19 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut76 happy_x_1 of { happy_var_1 -> case happyOut33 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CFunDef [] happy_var_1 (reverse happy_var_2) happy_var_3)}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_20 = happyMonadReduce 4# 3# happyReduction_20 happyReduction_20 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut76 happy_x_2 of { happy_var_2 -> case happyOut33 happy_x_3 of { happy_var_3 -> case happyOut14 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_2 $ CFunDef (liftCAttrs happy_var_1) happy_var_2 (reverse happy_var_3) happy_var_4)}}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_21 = happyMonadReduce 4# 3# happyReduction_21 happyReduction_21 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut76 happy_x_2 of { happy_var_2 -> case happyOut33 happy_x_3 of { happy_var_3 -> case happyOut14 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CFunDef happy_var_1 happy_var_2 (reverse happy_var_3) happy_var_4)}}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_22 = happyMonadReduce 4# 3# happyReduction_22 happyReduction_22 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut76 happy_x_2 of { happy_var_2 -> case happyOut33 happy_x_3 of { happy_var_3 -> case happyOut14 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CFunDef happy_var_1 happy_var_2 (reverse happy_var_3) happy_var_4)}}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_23 = happyMonadReduce 4# 3# happyReduction_23 happyReduction_23 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut76 happy_x_2 of { happy_var_2 -> case happyOut33 happy_x_3 of { happy_var_3 -> case happyOut14 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CFunDef (reverse happy_var_1) happy_var_2 (reverse happy_var_3) happy_var_4)}}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_24 = happyMonadReduce 4# 3# happyReduction_24 happyReduction_24 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut76 happy_x_2 of { happy_var_2 -> case happyOut33 happy_x_3 of { happy_var_3 -> case happyOut14 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CFunDef (liftTypeQuals happy_var_1) happy_var_2 (reverse happy_var_3) happy_var_4)}}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_25 = happyMonadReduce 5# 3# happyReduction_25 happyReduction_25 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut76 happy_x_3 of { happy_var_3 -> case happyOut33 happy_x_4 of { happy_var_4 -> case happyOut14 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CFunDef (liftTypeQuals happy_var_1 ++ liftCAttrs happy_var_2) happy_var_3 (reverse happy_var_4) happy_var_5)}}}}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_26 = happyMonadReduce 1# 4# happyReduction_26 happyReduction_26 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut72 happy_x_1 of { happy_var_1 -> ( let declr = reverseDeclr happy_var_1 in enterScope >> doFuncParamDeclIdent declr >> return declr)} ) (\r -> happyReturn (happyIn11 r)) happyReduce_27 = happySpecReduce_1 5# happyReduction_27 happyReduction_27 happy_x_1 = case happyOut13 happy_x_1 of { happy_var_1 -> happyIn12 (happy_var_1 )} happyReduce_28 = happySpecReduce_1 5# happyReduction_28 happyReduction_28 happy_x_1 = case happyOut14 happy_x_1 of { happy_var_1 -> happyIn12 (happy_var_1 )} happyReduce_29 = happySpecReduce_1 5# happyReduction_29 happyReduction_29 happy_x_1 = case happyOut22 happy_x_1 of { happy_var_1 -> happyIn12 (happy_var_1 )} happyReduce_30 = happySpecReduce_1 5# happyReduction_30 happyReduction_30 happy_x_1 = case happyOut23 happy_x_1 of { happy_var_1 -> happyIn12 (happy_var_1 )} happyReduce_31 = happySpecReduce_1 5# happyReduction_31 happyReduction_31 happy_x_1 = case happyOut24 happy_x_1 of { happy_var_1 -> happyIn12 (happy_var_1 )} happyReduce_32 = happySpecReduce_1 5# happyReduction_32 happyReduction_32 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> happyIn12 (happy_var_1 )} happyReduce_33 = happyMonadReduce 1# 5# happyReduction_33 happyReduction_33 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut26 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 (CAsm happy_var_1))} ) (\r -> happyReturn (happyIn12 r)) happyReduce_34 = happyMonadReduce 4# 6# happyReduction_34 happyReduction_34 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut125 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_3 of { happy_var_3 -> case happyOut12 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CLabel happy_var_1 happy_var_4 happy_var_3)}}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_35 = happyMonadReduce 4# 6# happyReduction_35 happyReduction_35 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut121 happy_x_2 of { happy_var_2 -> case happyOut12 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CCase happy_var_2 happy_var_4)}}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_36 = happyMonadReduce 3# 6# happyReduction_36 happyReduction_36 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut12 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CDefault happy_var_3)}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_37 = happyMonadReduce 6# 6# 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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut121 happy_x_2 of { happy_var_2 -> case happyOut121 happy_x_4 of { happy_var_4 -> case happyOut12 happy_x_6 of { happy_var_6 -> ( withNodeInfo happy_var_1 $ CCases happy_var_2 happy_var_4 happy_var_6)}}}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_38 = happyMonadReduce 5# 7# happyReduction_38 happyReduction_38 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut17 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CCompound [] (reverse happy_var_3))}} ) (\r -> happyReturn (happyIn14 r)) happyReduce_39 = happyMonadReduce 6# 7# happyReduction_39 happyReduction_39 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut17 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CCompound (reverse happy_var_3) (reverse happy_var_4))}}} ) (\r -> happyReturn (happyIn14 r)) happyReduce_40 = happyMonadReduce 0# 8# happyReduction_40 happyReduction_40 (happyRest) tk = happyThen (( enterScope) ) (\r -> happyReturn (happyIn15 r)) happyReduce_41 = happyMonadReduce 0# 9# happyReduction_41 happyReduction_41 (happyRest) tk = happyThen (( leaveScope) ) (\r -> happyReturn (happyIn16 r)) happyReduce_42 = happySpecReduce_0 10# happyReduction_42 happyReduction_42 = happyIn17 (empty ) happyReduce_43 = happySpecReduce_2 10# happyReduction_43 happyReduction_43 happy_x_2 happy_x_1 = case happyOut17 happy_x_1 of { happy_var_1 -> case happyOut18 happy_x_2 of { happy_var_2 -> happyIn17 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_44 = happySpecReduce_1 11# happyReduction_44 happyReduction_44 happy_x_1 = case happyOut12 happy_x_1 of { happy_var_1 -> happyIn18 (CBlockStmt happy_var_1 )} happyReduce_45 = happySpecReduce_1 11# happyReduction_45 happyReduction_45 happy_x_1 = case happyOut19 happy_x_1 of { happy_var_1 -> happyIn18 (happy_var_1 )} happyReduce_46 = happySpecReduce_1 12# happyReduction_46 happyReduction_46 happy_x_1 = case happyOut32 happy_x_1 of { happy_var_1 -> happyIn19 (CBlockDecl happy_var_1 )} happyReduce_47 = happySpecReduce_1 12# happyReduction_47 happyReduction_47 happy_x_1 = case happyOut20 happy_x_1 of { happy_var_1 -> happyIn19 (CNestedFunDef happy_var_1 )} happyReduce_48 = happySpecReduce_2 12# happyReduction_48 happyReduction_48 happy_x_2 happy_x_1 = case happyOut19 happy_x_2 of { happy_var_2 -> happyIn19 (happy_var_2 )} happyReduce_49 = happyMonadReduce 3# 13# happyReduction_49 happyReduction_49 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef happy_var_1 happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn20 r)) happyReduce_50 = happyMonadReduce 3# 13# happyReduction_50 happyReduction_50 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef happy_var_1 happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn20 r)) happyReduce_51 = happyMonadReduce 3# 13# happyReduction_51 happyReduction_51 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef (reverse happy_var_1) happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn20 r)) happyReduce_52 = happyMonadReduce 3# 13# happyReduction_52 happyReduction_52 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef (liftTypeQuals happy_var_1) happy_var_2 [] happy_var_3))}}} ) (\r -> happyReturn (happyIn20 r)) happyReduce_53 = happyMonadReduce 4# 13# happyReduction_53 happyReduction_53 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut11 happy_x_3 of { happy_var_3 -> case happyOut14 happy_x_4 of { happy_var_4 -> ( leaveScope >> (withNodeInfo happy_var_1 $ CFunDef (liftTypeQuals happy_var_1 ++ liftCAttrs happy_var_2) happy_var_3 [] happy_var_4))}}}} ) (\r -> happyReturn (happyIn20 r)) happyReduce_54 = happySpecReduce_3 14# happyReduction_54 happyReduction_54 happy_x_3 happy_x_2 happy_x_1 = case happyOut82 happy_x_2 of { happy_var_2 -> happyIn21 (happy_var_2 )} happyReduce_55 = happyReduce 4# 14# happyReduction_55 happyReduction_55 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut21 happy_x_1 of { happy_var_1 -> case happyOut82 happy_x_3 of { happy_var_3 -> happyIn21 (happy_var_1 `rappendr` happy_var_3 ) `HappyStk` happyRest}} happyReduce_56 = happyMonadReduce 1# 15# happyReduction_56 happyReduction_56 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CExpr Nothing)} ) (\r -> happyReturn (happyIn22 r)) happyReduce_57 = happyMonadReduce 2# 15# happyReduction_57 happyReduction_57 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut117 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CExpr (Just happy_var_1))} ) (\r -> happyReturn (happyIn22 r)) happyReduce_58 = happyMonadReduce 5# 16# happyReduction_58 happyReduction_58 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> case happyOut12 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CIf happy_var_3 happy_var_5 Nothing)}}} ) (\r -> happyReturn (happyIn23 r)) happyReduce_59 = happyMonadReduce 7# 16# happyReduction_59 happyReduction_59 (happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> case happyOut12 happy_x_5 of { happy_var_5 -> case happyOut12 happy_x_7 of { happy_var_7 -> ( withNodeInfo happy_var_1 $ CIf happy_var_3 happy_var_5 (Just happy_var_7))}}}} ) (\r -> happyReturn (happyIn23 r)) happyReduce_60 = happyMonadReduce 5# 16# happyReduction_60 happyReduction_60 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> case happyOut12 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CSwitch happy_var_3 happy_var_5)}}} ) (\r -> happyReturn (happyIn23 r)) happyReduce_61 = happyMonadReduce 5# 17# happyReduction_61 happyReduction_61 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> case happyOut12 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CWhile happy_var_3 happy_var_5 False)}}} ) (\r -> happyReturn (happyIn24 r)) happyReduce_62 = happyMonadReduce 7# 17# happyReduction_62 happyReduction_62 (happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut12 happy_x_2 of { happy_var_2 -> case happyOut117 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CWhile happy_var_5 happy_var_2 True)}}} ) (\r -> happyReturn (happyIn24 r)) happyReduce_63 = happyMonadReduce 9# 17# happyReduction_63 happyReduction_63 (happy_x_9 `HappyStk` happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut119 happy_x_3 of { happy_var_3 -> case happyOut119 happy_x_5 of { happy_var_5 -> case happyOut119 happy_x_7 of { happy_var_7 -> case happyOut12 happy_x_9 of { happy_var_9 -> ( withNodeInfo happy_var_1 $ CFor (Left happy_var_3) happy_var_5 happy_var_7 happy_var_9)}}}}} ) (\r -> happyReturn (happyIn24 r)) happyReduce_64 = happyMonadReduce 10# 17# happyReduction_64 happyReduction_64 (happy_x_10 `HappyStk` happy_x_9 `HappyStk` happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut32 happy_x_4 of { happy_var_4 -> case happyOut119 happy_x_5 of { happy_var_5 -> case happyOut119 happy_x_7 of { happy_var_7 -> case happyOut12 happy_x_9 of { happy_var_9 -> ( withNodeInfo happy_var_1 $ CFor (Right happy_var_4) happy_var_5 happy_var_7 happy_var_9)}}}}} ) (\r -> happyReturn (happyIn24 r)) happyReduce_65 = happyMonadReduce 3# 18# happyReduction_65 happyReduction_65 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut125 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CGoto happy_var_2)}} ) (\r -> happyReturn (happyIn25 r)) happyReduce_66 = happyMonadReduce 4# 18# happyReduction_66 happyReduction_66 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CGotoPtr happy_var_3)}} ) (\r -> happyReturn (happyIn25 r)) happyReduce_67 = happyMonadReduce 2# 18# happyReduction_67 happyReduction_67 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CCont)} ) (\r -> happyReturn (happyIn25 r)) happyReduce_68 = happyMonadReduce 2# 18# happyReduction_68 happyReduction_68 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CBreak)} ) (\r -> happyReturn (happyIn25 r)) happyReduce_69 = happyMonadReduce 3# 18# happyReduction_69 happyReduction_69 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut119 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CReturn happy_var_2)}} ) (\r -> happyReturn (happyIn25 r)) happyReduce_70 = happyMonadReduce 6# 19# happyReduction_70 happyReduction_70 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut27 happy_x_2 of { happy_var_2 -> case happyOut123 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CAsmStmt happy_var_2 happy_var_4 [] [] [])}}} ) (\r -> happyReturn (happyIn26 r)) happyReduce_71 = happyMonadReduce 8# 19# happyReduction_71 happyReduction_71 (happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut27 happy_x_2 of { happy_var_2 -> case happyOut123 happy_x_4 of { happy_var_4 -> case happyOut28 happy_x_6 of { happy_var_6 -> ( withNodeInfo happy_var_1 $ CAsmStmt happy_var_2 happy_var_4 happy_var_6 [] [])}}}} ) (\r -> happyReturn (happyIn26 r)) happyReduce_72 = happyMonadReduce 10# 19# happyReduction_72 happyReduction_72 (happy_x_10 `HappyStk` happy_x_9 `HappyStk` happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut27 happy_x_2 of { happy_var_2 -> case happyOut123 happy_x_4 of { happy_var_4 -> case happyOut28 happy_x_6 of { happy_var_6 -> case happyOut28 happy_x_8 of { happy_var_8 -> ( withNodeInfo happy_var_1 $ CAsmStmt happy_var_2 happy_var_4 happy_var_6 happy_var_8 [])}}}}} ) (\r -> happyReturn (happyIn26 r)) happyReduce_73 = happyMonadReduce 12# 19# happyReduction_73 happyReduction_73 (happy_x_12 `HappyStk` happy_x_11 `HappyStk` happy_x_10 `HappyStk` happy_x_9 `HappyStk` happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut27 happy_x_2 of { happy_var_2 -> case happyOut123 happy_x_4 of { happy_var_4 -> case happyOut28 happy_x_6 of { happy_var_6 -> case happyOut28 happy_x_8 of { happy_var_8 -> case happyOut31 happy_x_10 of { happy_var_10 -> ( withNodeInfo happy_var_1 $ CAsmStmt happy_var_2 happy_var_4 happy_var_6 happy_var_8 (reverse happy_var_10))}}}}}} ) (\r -> happyReturn (happyIn26 r)) happyReduce_74 = happySpecReduce_0 20# happyReduction_74 happyReduction_74 = happyIn27 (Nothing ) happyReduce_75 = happySpecReduce_1 20# happyReduction_75 happyReduction_75 happy_x_1 = case happyOut61 happy_x_1 of { happy_var_1 -> happyIn27 (Just happy_var_1 )} happyReduce_76 = happySpecReduce_0 21# happyReduction_76 happyReduction_76 = happyIn28 ([] ) happyReduce_77 = happySpecReduce_1 21# happyReduction_77 happyReduction_77 happy_x_1 = case happyOut29 happy_x_1 of { happy_var_1 -> happyIn28 (reverse happy_var_1 )} happyReduce_78 = happySpecReduce_1 22# happyReduction_78 happyReduction_78 happy_x_1 = case happyOut30 happy_x_1 of { happy_var_1 -> happyIn29 (singleton happy_var_1 )} happyReduce_79 = happySpecReduce_3 22# happyReduction_79 happyReduction_79 happy_x_3 happy_x_2 happy_x_1 = case happyOut29 happy_x_1 of { happy_var_1 -> case happyOut30 happy_x_3 of { happy_var_3 -> happyIn29 (happy_var_1 `snoc` happy_var_3 )}} happyReduce_80 = happyMonadReduce 4# 23# happyReduction_80 happyReduction_80 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut123 happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CAsmOperand Nothing happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn30 r)) happyReduce_81 = happyMonadReduce 7# 23# happyReduction_81 happyReduction_81 (happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (CTokIdent _ happy_var_2) -> case happyOut123 happy_x_4 of { happy_var_4 -> case happyOut117 happy_x_6 of { happy_var_6 -> ( withNodeInfo happy_var_1 $ CAsmOperand (Just happy_var_2) happy_var_4 happy_var_6)}}}} ) (\r -> happyReturn (happyIn30 r)) happyReduce_82 = happyMonadReduce 7# 23# happyReduction_82 happyReduction_82 (happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (CTokTyIdent _ happy_var_2) -> case happyOut123 happy_x_4 of { happy_var_4 -> case happyOut117 happy_x_6 of { happy_var_6 -> ( withNodeInfo happy_var_1 $ CAsmOperand (Just happy_var_2) happy_var_4 happy_var_6)}}}} ) (\r -> happyReturn (happyIn30 r)) happyReduce_83 = happySpecReduce_1 24# happyReduction_83 happyReduction_83 happy_x_1 = case happyOut123 happy_x_1 of { happy_var_1 -> happyIn31 (singleton happy_var_1 )} happyReduce_84 = happySpecReduce_3 24# happyReduction_84 happyReduction_84 happy_x_3 happy_x_2 happy_x_1 = case happyOut31 happy_x_1 of { happy_var_1 -> case happyOut123 happy_x_3 of { happy_var_3 -> happyIn31 (happy_var_1 `snoc` happy_var_3 )}} happyReduce_85 = happyMonadReduce 2# 25# happyReduction_85 happyReduction_85 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut45 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDecl (reverse happy_var_1) [])} ) (\r -> happyReturn (happyIn32 r)) happyReduce_86 = happyMonadReduce 2# 25# happyReduction_86 happyReduction_86 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut46 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDecl (reverse happy_var_1) [])} ) (\r -> happyReturn (happyIn32 r)) happyReduce_87 = happyMonadReduce 2# 25# happyReduction_87 happyReduction_87 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut36 happy_x_1 of { happy_var_1 -> ( case happy_var_1 of CDecl declspecs dies at -> withLength at (CDecl declspecs (List.reverse dies)))} ) (\r -> happyReturn (happyIn32 r)) happyReduce_88 = happyMonadReduce 2# 25# happyReduction_88 happyReduction_88 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> ( case happy_var_1 of CDecl declspecs dies at -> withLength at (CDecl declspecs (List.reverse dies)))} ) (\r -> happyReturn (happyIn32 r)) happyReduce_89 = happySpecReduce_0 26# happyReduction_89 happyReduction_89 = happyIn33 (empty ) happyReduce_90 = happySpecReduce_2 26# happyReduction_90 happyReduction_90 happy_x_2 happy_x_1 = case happyOut33 happy_x_1 of { happy_var_1 -> case happyOut32 happy_x_2 of { happy_var_2 -> happyIn33 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_91 = happyMonadReduce 4# 27# happyReduction_91 happyReduction_91 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOut35 happy_x_3 of { happy_var_3 -> case happyOut91 happy_x_4 of { happy_var_4 -> ( let declspecs = reverse happy_var_1 in do{ declr <- withAsmNameAttrs happy_var_3 happy_var_2 ; doDeclIdent declspecs declr ; withNodeInfo happy_var_1 $ CDecl declspecs [(Just (reverseDeclr declr), happy_var_4, Nothing)] })}}}} ) (\r -> happyReturn (happyIn34 r)) happyReduce_92 = happyMonadReduce 4# 27# happyReduction_92 happyReduction_92 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOut35 happy_x_3 of { happy_var_3 -> case happyOut91 happy_x_4 of { happy_var_4 -> ( let declspecs = liftTypeQuals happy_var_1 in do{ declr <- withAsmNameAttrs happy_var_3 happy_var_2 ; doDeclIdent declspecs declr ; withNodeInfo happy_var_1 $ CDecl declspecs [(Just (reverseDeclr declr), happy_var_4, Nothing)] })}}}} ) (\r -> happyReturn (happyIn34 r)) happyReduce_93 = happyMonadReduce 5# 27# happyReduction_93 happyReduction_93 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut72 happy_x_3 of { happy_var_3 -> case happyOut35 happy_x_4 of { happy_var_4 -> case happyOut91 happy_x_5 of { happy_var_5 -> ( let declspecs = liftTypeQuals happy_var_1 in do{ declr <- withAsmNameAttrs happy_var_4 happy_var_3 ; doDeclIdent declspecs declr ; withNodeInfo happy_var_1 $ CDecl (declspecs ++ liftCAttrs happy_var_2) [(Just (reverseDeclr declr), happy_var_5, Nothing)] })}}}}} ) (\r -> happyReturn (happyIn34 r)) happyReduce_94 = happyMonadReduce 4# 27# happyReduction_94 happyReduction_94 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOut35 happy_x_3 of { happy_var_3 -> case happyOut91 happy_x_4 of { happy_var_4 -> ( let declspecs = liftCAttrs happy_var_1 in do{ declr <- withAsmNameAttrs happy_var_3 happy_var_2 ; doDeclIdent declspecs declr ; withNodeInfo happy_var_1 $ CDecl declspecs [(Just (reverseDeclr declr), happy_var_4, Nothing)] })}}}} ) (\r -> happyReturn (happyIn34 r)) happyReduce_95 = happyMonadReduce 6# 27# happyReduction_95 happyReduction_95 (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) tk = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_3 of { happy_var_3 -> case happyOut72 happy_x_4 of { happy_var_4 -> case happyOut35 happy_x_5 of { happy_var_5 -> case happyOut91 happy_x_6 of { happy_var_6 -> ( case happy_var_1 of CDecl declspecs dies at -> do declr <- withAsmNameAttrs (fst happy_var_5, snd happy_var_5 ++ happy_var_3) happy_var_4 doDeclIdent declspecs declr withLength at $ CDecl declspecs ((Just (reverseDeclr declr), happy_var_6, Nothing) : dies))}}}}} ) (\r -> happyReturn (happyIn34 r)) happyReduce_96 = happySpecReduce_2 28# happyReduction_96 happyReduction_96 happy_x_2 happy_x_1 = case happyOut64 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> happyIn35 ((happy_var_1,happy_var_2) )}} happyReduce_97 = happyMonadReduce 4# 29# happyReduction_97 happyReduction_97 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut63 happy_x_2 of { happy_var_2 -> case happyOut35 happy_x_3 of { happy_var_3 -> case happyOut91 happy_x_4 of { happy_var_4 -> ( do{ declr <- withAsmNameAttrs happy_var_3 happy_var_2; doDeclIdent happy_var_1 declr; withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr declr), happy_var_4, Nothing)] })}}}} ) (\r -> happyReturn (happyIn36 r)) happyReduce_98 = happyMonadReduce 4# 29# happyReduction_98 happyReduction_98 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut63 happy_x_2 of { happy_var_2 -> case happyOut35 happy_x_3 of { happy_var_3 -> case happyOut91 happy_x_4 of { happy_var_4 -> ( do{ declr <- withAsmNameAttrs happy_var_3 happy_var_2; doDeclIdent happy_var_1 declr; withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr declr), happy_var_4, Nothing)] })}}}} ) (\r -> happyReturn (happyIn36 r)) happyReduce_99 = happyMonadReduce 6# 29# happyReduction_99 happyReduction_99 (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) tk = happyThen (case happyOut36 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_3 of { happy_var_3 -> case happyOut63 happy_x_4 of { happy_var_4 -> case happyOut35 happy_x_5 of { happy_var_5 -> case happyOut91 happy_x_6 of { happy_var_6 -> ( case happy_var_1 of CDecl declspecs dies at -> do declr <- withAsmNameAttrs (fst happy_var_5, snd happy_var_5 ++ happy_var_3) happy_var_4 doDeclIdent declspecs declr return (CDecl declspecs ((Just (reverseDeclr declr), happy_var_6, Nothing) : dies) at))}}}}} ) (\r -> happyReturn (happyIn36 r)) happyReduce_100 = happySpecReduce_1 30# happyReduction_100 happyReduction_100 happy_x_1 = case happyOut43 happy_x_1 of { happy_var_1 -> happyIn37 (reverse happy_var_1 )} happyReduce_101 = happySpecReduce_1 30# happyReduction_101 happyReduction_101 happy_x_1 = case happyOut45 happy_x_1 of { happy_var_1 -> happyIn37 (reverse happy_var_1 )} happyReduce_102 = happySpecReduce_1 30# happyReduction_102 happyReduction_102 happy_x_1 = case happyOut47 happy_x_1 of { happy_var_1 -> happyIn37 (reverse happy_var_1 )} happyReduce_103 = happySpecReduce_1 31# happyReduction_103 happyReduction_103 happy_x_1 = case happyOut40 happy_x_1 of { happy_var_1 -> happyIn38 (singleton (CStorageSpec happy_var_1) )} happyReduce_104 = happySpecReduce_2 31# happyReduction_104 happyReduction_104 happy_x_2 happy_x_1 = case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut40 happy_x_2 of { happy_var_2 -> happyIn38 (reverseList (liftCAttrs happy_var_1) `snoc` (CStorageSpec happy_var_2) )}} happyReduce_105 = happySpecReduce_2 31# happyReduction_105 happyReduction_105 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut40 happy_x_2 of { happy_var_2 -> happyIn38 (rmap CTypeQual happy_var_1 `snoc` CStorageSpec happy_var_2 )}} happyReduce_106 = happySpecReduce_3 31# happyReduction_106 happyReduction_106 happy_x_3 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut40 happy_x_3 of { happy_var_3 -> happyIn38 ((rmap CTypeQual happy_var_1 `rappend` liftCAttrs happy_var_2) `snoc` CStorageSpec happy_var_3 )}}} happyReduce_107 = happySpecReduce_2 31# happyReduction_107 happyReduction_107 happy_x_2 happy_x_1 = case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut39 happy_x_2 of { happy_var_2 -> happyIn38 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_108 = happySpecReduce_2 31# happyReduction_108 happyReduction_108 happy_x_2 happy_x_1 = case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn38 (addTrailingAttrs happy_var_1 happy_var_2 )}} happyReduce_109 = happySpecReduce_1 32# happyReduction_109 happyReduction_109 happy_x_1 = case happyOut40 happy_x_1 of { happy_var_1 -> happyIn39 (CStorageSpec happy_var_1 )} happyReduce_110 = happySpecReduce_1 32# happyReduction_110 happyReduction_110 happy_x_1 = case happyOut61 happy_x_1 of { happy_var_1 -> happyIn39 (CTypeQual happy_var_1 )} happyReduce_111 = happyMonadReduce 1# 33# happyReduction_111 happyReduction_111 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CTypedef)} ) (\r -> happyReturn (happyIn40 r)) happyReduce_112 = happyMonadReduce 1# 33# happyReduction_112 happyReduction_112 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CExtern)} ) (\r -> happyReturn (happyIn40 r)) happyReduce_113 = happyMonadReduce 1# 33# happyReduction_113 happyReduction_113 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CStatic)} ) (\r -> happyReturn (happyIn40 r)) happyReduce_114 = happyMonadReduce 1# 33# happyReduction_114 happyReduction_114 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CAuto)} ) (\r -> happyReturn (happyIn40 r)) happyReduce_115 = happyMonadReduce 1# 33# happyReduction_115 happyReduction_115 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CRegister)} ) (\r -> happyReturn (happyIn40 r)) happyReduce_116 = happyMonadReduce 1# 33# happyReduction_116 happyReduction_116 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CThread)} ) (\r -> happyReturn (happyIn40 r)) happyReduce_117 = happySpecReduce_1 34# happyReduction_117 happyReduction_117 happy_x_1 = case happyOut44 happy_x_1 of { happy_var_1 -> happyIn41 (reverse happy_var_1 )} happyReduce_118 = happySpecReduce_1 34# happyReduction_118 happyReduction_118 happy_x_1 = case happyOut46 happy_x_1 of { happy_var_1 -> happyIn41 (reverse happy_var_1 )} happyReduce_119 = happySpecReduce_1 34# happyReduction_119 happyReduction_119 happy_x_1 = case happyOut48 happy_x_1 of { happy_var_1 -> happyIn41 (reverse happy_var_1 )} happyReduce_120 = happyMonadReduce 1# 35# happyReduction_120 happyReduction_120 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CVoidType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_121 = happyMonadReduce 1# 35# happyReduction_121 happyReduction_121 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CCharType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_122 = happyMonadReduce 1# 35# happyReduction_122 happyReduction_122 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CShortType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_123 = happyMonadReduce 1# 35# happyReduction_123 happyReduction_123 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CIntType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_124 = happyMonadReduce 1# 35# happyReduction_124 happyReduction_124 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CLongType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_125 = happyMonadReduce 1# 35# happyReduction_125 happyReduction_125 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CFloatType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_126 = happyMonadReduce 1# 35# happyReduction_126 happyReduction_126 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDoubleType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_127 = happyMonadReduce 1# 35# happyReduction_127 happyReduction_127 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CSignedType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_128 = happyMonadReduce 1# 35# happyReduction_128 happyReduction_128 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CUnsigType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_129 = happyMonadReduce 1# 35# happyReduction_129 happyReduction_129 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CBoolType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_130 = happyMonadReduce 1# 35# happyReduction_130 happyReduction_130 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CComplexType)} ) (\r -> happyReturn (happyIn42 r)) happyReduce_131 = happySpecReduce_2 36# happyReduction_131 happyReduction_131 happy_x_2 happy_x_1 = case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut42 happy_x_2 of { happy_var_2 -> happyIn43 (happy_var_1 `snoc` CTypeSpec happy_var_2 )}} happyReduce_132 = happySpecReduce_2 36# happyReduction_132 happyReduction_132 happy_x_2 happy_x_1 = case happyOut44 happy_x_1 of { happy_var_1 -> case happyOut40 happy_x_2 of { happy_var_2 -> happyIn43 (happy_var_1 `snoc` CStorageSpec happy_var_2 )}} happyReduce_133 = happySpecReduce_2 36# happyReduction_133 happyReduction_133 happy_x_2 happy_x_1 = case happyOut43 happy_x_1 of { happy_var_1 -> case happyOut39 happy_x_2 of { happy_var_2 -> happyIn43 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_134 = happySpecReduce_2 36# happyReduction_134 happyReduction_134 happy_x_2 happy_x_1 = case happyOut43 happy_x_1 of { happy_var_1 -> case happyOut42 happy_x_2 of { happy_var_2 -> happyIn43 (happy_var_1 `snoc` CTypeSpec happy_var_2 )}} happyReduce_135 = happySpecReduce_2 36# happyReduction_135 happyReduction_135 happy_x_2 happy_x_1 = case happyOut43 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn43 (addTrailingAttrs happy_var_1 happy_var_2 )}} happyReduce_136 = happySpecReduce_1 37# happyReduction_136 happyReduction_136 happy_x_1 = case happyOut42 happy_x_1 of { happy_var_1 -> happyIn44 (singleton (CTypeSpec happy_var_1) )} happyReduce_137 = happySpecReduce_2 37# happyReduction_137 happyReduction_137 happy_x_2 happy_x_1 = case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut42 happy_x_2 of { happy_var_2 -> happyIn44 ((reverseList $ liftCAttrs happy_var_1) `snoc` (CTypeSpec happy_var_2) )}} happyReduce_138 = happySpecReduce_2 37# happyReduction_138 happyReduction_138 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut42 happy_x_2 of { happy_var_2 -> happyIn44 (rmap CTypeQual happy_var_1 `snoc` CTypeSpec happy_var_2 )}} happyReduce_139 = happySpecReduce_3 37# happyReduction_139 happyReduction_139 happy_x_3 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut42 happy_x_3 of { happy_var_3 -> happyIn44 (rmap CTypeQual happy_var_1 `rappend` (liftCAttrs happy_var_2) `snoc` CTypeSpec happy_var_3 )}}} happyReduce_140 = happySpecReduce_2 37# happyReduction_140 happyReduction_140 happy_x_2 happy_x_1 = case happyOut44 happy_x_1 of { happy_var_1 -> case happyOut61 happy_x_2 of { happy_var_2 -> happyIn44 (happy_var_1 `snoc` CTypeQual happy_var_2 )}} happyReduce_141 = happySpecReduce_2 37# happyReduction_141 happyReduction_141 happy_x_2 happy_x_1 = case happyOut44 happy_x_1 of { happy_var_1 -> case happyOut42 happy_x_2 of { happy_var_2 -> happyIn44 (happy_var_1 `snoc` CTypeSpec happy_var_2 )}} happyReduce_142 = happySpecReduce_2 37# happyReduction_142 happyReduction_142 happy_x_2 happy_x_1 = case happyOut44 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn44 (addTrailingAttrs happy_var_1 happy_var_2 )}} happyReduce_143 = happySpecReduce_2 38# happyReduction_143 happyReduction_143 happy_x_2 happy_x_1 = case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut49 happy_x_2 of { happy_var_2 -> happyIn45 (happy_var_1 `snoc` CTypeSpec happy_var_2 )}} happyReduce_144 = happySpecReduce_2 38# happyReduction_144 happyReduction_144 happy_x_2 happy_x_1 = case happyOut46 happy_x_1 of { happy_var_1 -> case happyOut40 happy_x_2 of { happy_var_2 -> happyIn45 (happy_var_1 `snoc` CStorageSpec happy_var_2 )}} happyReduce_145 = happySpecReduce_2 38# happyReduction_145 happyReduction_145 happy_x_2 happy_x_1 = case happyOut45 happy_x_1 of { happy_var_1 -> case happyOut39 happy_x_2 of { happy_var_2 -> happyIn45 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_146 = happySpecReduce_2 38# happyReduction_146 happyReduction_146 happy_x_2 happy_x_1 = case happyOut45 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn45 (addTrailingAttrs happy_var_1 happy_var_2 )}} happyReduce_147 = happySpecReduce_1 39# happyReduction_147 happyReduction_147 happy_x_1 = case happyOut49 happy_x_1 of { happy_var_1 -> happyIn46 (singleton (CTypeSpec happy_var_1) )} happyReduce_148 = happySpecReduce_2 39# happyReduction_148 happyReduction_148 happy_x_2 happy_x_1 = case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut49 happy_x_2 of { happy_var_2 -> happyIn46 ((reverseList $ liftCAttrs happy_var_1) `snoc` (CTypeSpec happy_var_2) )}} happyReduce_149 = happySpecReduce_2 39# happyReduction_149 happyReduction_149 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut49 happy_x_2 of { happy_var_2 -> happyIn46 (rmap CTypeQual happy_var_1 `snoc` CTypeSpec happy_var_2 )}} happyReduce_150 = happySpecReduce_3 39# happyReduction_150 happyReduction_150 happy_x_3 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut49 happy_x_3 of { happy_var_3 -> happyIn46 (rmap CTypeQual happy_var_1 `rappend` (liftCAttrs happy_var_2) `snoc` CTypeSpec happy_var_3 )}}} happyReduce_151 = happySpecReduce_2 39# happyReduction_151 happyReduction_151 happy_x_2 happy_x_1 = case happyOut46 happy_x_1 of { happy_var_1 -> case happyOut61 happy_x_2 of { happy_var_2 -> happyIn46 (happy_var_1 `snoc` CTypeQual happy_var_2 )}} happyReduce_152 = happySpecReduce_2 39# happyReduction_152 happyReduction_152 happy_x_2 happy_x_1 = case happyOut46 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn46 (addTrailingAttrs happy_var_1 happy_var_2 )}} happyReduce_153 = happySpecReduce_2 40# happyReduction_153 happyReduction_153 happy_x_2 happy_x_1 = case happyOut48 happy_x_1 of { happy_var_1 -> case happyOut40 happy_x_2 of { happy_var_2 -> happyIn47 (happy_var_1 `snoc` CStorageSpec happy_var_2 )}} happyReduce_154 = happyMonadReduce 2# 40# happyReduction_154 happyReduction_154 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (CTokTyIdent _ happy_var_2) -> ( withNodeInfo happy_var_2 $ \at -> happy_var_1 `snoc` CTypeSpec (CTypeDef happy_var_2 at))}} ) (\r -> happyReturn (happyIn47 r)) happyReduce_155 = happyMonadReduce 5# 40# happyReduction_155 happyReduction_155 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOut117 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_2 $ \at -> happy_var_1 `snoc` CTypeSpec (CTypeOfExpr happy_var_4 at))}}} ) (\r -> happyReturn (happyIn47 r)) happyReduce_156 = happyMonadReduce 5# 40# happyReduction_156 happyReduction_156 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOut83 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_2 $ \at -> happy_var_1 `snoc` CTypeSpec (CTypeOfType happy_var_4 at))}}} ) (\r -> happyReturn (happyIn47 r)) happyReduce_157 = happySpecReduce_2 40# happyReduction_157 happyReduction_157 happy_x_2 happy_x_1 = case happyOut47 happy_x_1 of { happy_var_1 -> case happyOut39 happy_x_2 of { happy_var_2 -> happyIn47 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_158 = happySpecReduce_2 40# happyReduction_158 happyReduction_158 happy_x_2 happy_x_1 = case happyOut47 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn47 (addTrailingAttrs happy_var_1 happy_var_2 )}} happyReduce_159 = happyMonadReduce 1# 41# happyReduction_159 happyReduction_159 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> ( withNodeInfo happy_var_1 $ \at -> singleton (CTypeSpec (CTypeDef happy_var_1 at)))} ) (\r -> happyReturn (happyIn48 r)) happyReduce_160 = happyMonadReduce 4# 41# happyReduction_160 happyReduction_160 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ \at -> singleton (CTypeSpec (CTypeOfExpr happy_var_3 at)))}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_161 = happyMonadReduce 4# 41# happyReduction_161 happyReduction_161 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut83 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ \at -> singleton (CTypeSpec (CTypeOfType happy_var_3 at)))}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_162 = happyMonadReduce 2# 41# happyReduction_162 happyReduction_162 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (CTokTyIdent _ happy_var_2) -> ( withNodeInfo happy_var_2 $ \at -> rmap CTypeQual happy_var_1 `snoc` CTypeSpec (CTypeDef happy_var_2 at))}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_163 = happyMonadReduce 5# 41# happyReduction_163 happyReduction_163 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOut117 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_2 $ \at -> rmap CTypeQual happy_var_1 `snoc` CTypeSpec (CTypeOfExpr happy_var_4 at))}}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_164 = happyMonadReduce 5# 41# happyReduction_164 happyReduction_164 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOut83 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_2 $ \at -> rmap CTypeQual happy_var_1 `snoc` CTypeSpec (CTypeOfType happy_var_4 at))}}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_165 = happyMonadReduce 2# 41# happyReduction_165 happyReduction_165 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut127 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (CTokTyIdent _ happy_var_2) -> ( withNodeInfo happy_var_2 $ \at -> reverseList (liftCAttrs happy_var_1) `snoc` (CTypeSpec (CTypeDef happy_var_2 at)))}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_166 = happyMonadReduce 5# 41# happyReduction_166 happyReduction_166 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ \at -> reverseList (liftCAttrs happy_var_1) `snoc` (CTypeSpec (CTypeOfExpr happy_var_4 at)))}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_167 = happyMonadReduce 5# 41# happyReduction_167 happyReduction_167 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut127 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOut83 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_2 $ \at -> reverseList (liftCAttrs happy_var_1) `snoc` (CTypeSpec (CTypeOfType happy_var_4 at)))}}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_168 = happyMonadReduce 3# 41# happyReduction_168 happyReduction_168 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (CTokTyIdent _ happy_var_3) -> ( withNodeInfo happy_var_3 $ \at -> rmap CTypeQual happy_var_1 `rappend` (liftCAttrs happy_var_2) `snoc` CTypeSpec (CTypeDef happy_var_3 at))}}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_169 = happyMonadReduce 6# 41# happyReduction_169 happyReduction_169 (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) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { happy_var_3 -> case happyOut117 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_3 $ \at -> rmap CTypeQual happy_var_1 `rappend` (liftCAttrs happy_var_2) `snoc` CTypeSpec (CTypeOfExpr happy_var_5 at))}}}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_170 = happyMonadReduce 6# 41# happyReduction_170 happyReduction_170 (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) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { happy_var_3 -> case happyOut83 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_3 $ \at -> rmap CTypeQual happy_var_1 `rappend` (liftCAttrs happy_var_2) `snoc` CTypeSpec (CTypeOfType happy_var_5 at))}}}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_171 = happySpecReduce_2 41# happyReduction_171 happyReduction_171 happy_x_2 happy_x_1 = case happyOut48 happy_x_1 of { happy_var_1 -> case happyOut61 happy_x_2 of { happy_var_2 -> happyIn48 (happy_var_1 `snoc` CTypeQual happy_var_2 )}} happyReduce_172 = happySpecReduce_2 41# happyReduction_172 happyReduction_172 happy_x_2 happy_x_1 = case happyOut48 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn48 (addTrailingAttrs happy_var_1 happy_var_2 )}} happyReduce_173 = happyMonadReduce 1# 42# happyReduction_173 happyReduction_173 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut50 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CSUType happy_var_1)} ) (\r -> happyReturn (happyIn49 r)) happyReduce_174 = happyMonadReduce 1# 42# happyReduction_174 happyReduction_174 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut58 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CEnumType happy_var_1)} ) (\r -> happyReturn (happyIn49 r)) happyReduce_175 = happyMonadReduce 6# 43# happyReduction_175 happyReduction_175 (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) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut125 happy_x_3 of { happy_var_3 -> case happyOut52 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CStruct (unL happy_var_1) (Just happy_var_3) (Just$ reverse happy_var_5) happy_var_2)}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_176 = happyMonadReduce 5# 43# happyReduction_176 happyReduction_176 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut52 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CStruct (unL happy_var_1) Nothing (Just$ reverse happy_var_4) happy_var_2)}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_177 = happyMonadReduce 3# 43# happyReduction_177 happyReduction_177 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut125 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CStruct (unL happy_var_1) (Just happy_var_3) Nothing happy_var_2)}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_178 = happySpecReduce_1 44# happyReduction_178 happyReduction_178 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn51 (L CStructTag (posOf happy_var_1) )} happyReduce_179 = happySpecReduce_1 44# happyReduction_179 happyReduction_179 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn51 (L CUnionTag (posOf happy_var_1) )} happyReduce_180 = happySpecReduce_0 45# happyReduction_180 happyReduction_180 = happyIn52 (empty ) happyReduce_181 = happySpecReduce_2 45# happyReduction_181 happyReduction_181 happy_x_2 happy_x_1 = case happyOut52 happy_x_1 of { happy_var_1 -> happyIn52 (happy_var_1 )} happyReduce_182 = happySpecReduce_2 45# happyReduction_182 happyReduction_182 happy_x_2 happy_x_1 = case happyOut52 happy_x_1 of { happy_var_1 -> case happyOut53 happy_x_2 of { happy_var_2 -> happyIn52 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_183 = happySpecReduce_2 46# happyReduction_183 happyReduction_183 happy_x_2 happy_x_1 = case happyOut55 happy_x_1 of { happy_var_1 -> happyIn53 (case happy_var_1 of CDecl declspecs dies at -> CDecl declspecs (List.reverse dies) at )} happyReduce_184 = happySpecReduce_2 46# happyReduction_184 happyReduction_184 happy_x_2 happy_x_1 = case happyOut54 happy_x_1 of { happy_var_1 -> happyIn53 (case happy_var_1 of CDecl declspecs dies at -> CDecl declspecs (List.reverse dies) at )} happyReduce_185 = happySpecReduce_2 46# happyReduction_185 happyReduction_185 happy_x_2 happy_x_1 = case happyOut53 happy_x_2 of { happy_var_2 -> happyIn53 (happy_var_2 )} happyReduce_186 = happyMonadReduce 3# 47# happyReduction_186 happyReduction_186 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut57 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ case happy_var_3 of (d,s) -> CDecl (liftTypeQuals happy_var_1 ++ liftCAttrs happy_var_2) [(d,Nothing,s)])}}} ) (\r -> happyReturn (happyIn54 r)) happyReduce_187 = happyMonadReduce 2# 47# happyReduction_187 happyReduction_187 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut57 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ case happy_var_2 of (d,s) -> CDecl (liftCAttrs happy_var_1) [(d,Nothing,s)])}} ) (\r -> happyReturn (happyIn54 r)) happyReduce_188 = happyReduce 4# 47# happyReduction_188 happyReduction_188 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut54 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_3 of { happy_var_3 -> case happyOut57 happy_x_4 of { happy_var_4 -> happyIn54 (case happy_var_1 of CDecl declspecs dies at -> case happy_var_4 of (Just d,s) -> CDecl declspecs ((Just $ appendObjAttrs happy_var_3 d,Nothing,s) : dies) at (Nothing,s) -> CDecl declspecs ((Nothing,Nothing,s) : dies) at ) `HappyStk` happyRest}}} happyReduce_189 = happyMonadReduce 3# 48# happyReduction_189 happyReduction_189 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut56 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ case happy_var_2 of { (Just d,s) -> CDecl happy_var_1 [(Just $! appendObjAttrs happy_var_3 d,Nothing,s)] ; (Nothing,s) -> CDecl happy_var_1 [(Nothing,Nothing,s)] })}}} ) (\r -> happyReturn (happyIn55 r)) happyReduce_190 = happyReduce 5# 48# happyReduction_190 happyReduction_190 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut55 happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_3 of { happy_var_3 -> case happyOut56 happy_x_4 of { happy_var_4 -> case happyOut126 happy_x_5 of { happy_var_5 -> happyIn55 (case happy_var_1 of CDecl declspecs dies attr -> case happy_var_4 of (Just d,s) -> CDecl declspecs ((Just$ appendObjAttrs (happy_var_3++happy_var_5) d,Nothing,s) : dies) attr (Nothing,s) -> CDecl declspecs ((Nothing,Nothing,s) : dies) attr ) `HappyStk` happyRest}}}} happyReduce_191 = happyMonadReduce 1# 48# happyReduction_191 happyReduction_191 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [])} ) (\r -> happyReturn (happyIn55 r)) happyReduce_192 = happySpecReduce_1 49# happyReduction_192 happyReduction_192 happy_x_1 = case happyOut63 happy_x_1 of { happy_var_1 -> happyIn56 ((Just (reverseDeclr happy_var_1), Nothing) )} happyReduce_193 = happySpecReduce_2 49# happyReduction_193 happyReduction_193 happy_x_2 happy_x_1 = case happyOut121 happy_x_2 of { happy_var_2 -> happyIn56 ((Nothing, Just happy_var_2) )} happyReduce_194 = happySpecReduce_3 49# happyReduction_194 happyReduction_194 happy_x_3 happy_x_2 happy_x_1 = case happyOut63 happy_x_1 of { happy_var_1 -> case happyOut121 happy_x_3 of { happy_var_3 -> happyIn56 ((Just (reverseDeclr happy_var_1), Just happy_var_3) )}} happyReduce_195 = happySpecReduce_1 50# happyReduction_195 happyReduction_195 happy_x_1 = case happyOut72 happy_x_1 of { happy_var_1 -> happyIn57 ((Just (reverseDeclr happy_var_1), Nothing) )} happyReduce_196 = happySpecReduce_2 50# happyReduction_196 happyReduction_196 happy_x_2 happy_x_1 = case happyOut121 happy_x_2 of { happy_var_2 -> happyIn57 ((Nothing, Just happy_var_2) )} happyReduce_197 = happySpecReduce_3 50# happyReduction_197 happyReduction_197 happy_x_3 happy_x_2 happy_x_1 = case happyOut72 happy_x_1 of { happy_var_1 -> case happyOut121 happy_x_3 of { happy_var_3 -> happyIn57 ((Just (reverseDeclr happy_var_1), Just happy_var_3) )}} happyReduce_198 = happySpecReduce_2 50# happyReduction_198 happyReduction_198 happy_x_2 happy_x_1 = case happyOut57 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn57 (case happy_var_1 of { (Nothing,expr) -> (Nothing,expr) {- FIXME -} ; (Just (CDeclr name derived asmname attrs node), bsz) -> (Just (CDeclr name derived asmname (attrs++happy_var_2) node),bsz) } )}} happyReduce_199 = happyMonadReduce 5# 51# happyReduction_199 happyReduction_199 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut59 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CEnum Nothing (Just$ reverse happy_var_4) happy_var_2)}}} ) (\r -> happyReturn (happyIn58 r)) happyReduce_200 = happyMonadReduce 6# 51# happyReduction_200 happyReduction_200 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut59 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CEnum Nothing (Just$ reverse happy_var_4) happy_var_2)}}} ) (\r -> happyReturn (happyIn58 r)) happyReduce_201 = happyMonadReduce 6# 51# happyReduction_201 happyReduction_201 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut125 happy_x_3 of { happy_var_3 -> case happyOut59 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CEnum (Just happy_var_3) (Just$ reverse happy_var_5) happy_var_2)}}}} ) (\r -> happyReturn (happyIn58 r)) happyReduce_202 = happyMonadReduce 7# 51# happyReduction_202 happyReduction_202 (happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut125 happy_x_3 of { happy_var_3 -> case happyOut59 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CEnum (Just happy_var_3) (Just$ reverse happy_var_5) happy_var_2)}}}} ) (\r -> happyReturn (happyIn58 r)) happyReduce_203 = happyMonadReduce 3# 51# happyReduction_203 happyReduction_203 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_2 of { happy_var_2 -> case happyOut125 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CEnum (Just happy_var_3) Nothing happy_var_2)}}} ) (\r -> happyReturn (happyIn58 r)) happyReduce_204 = happySpecReduce_1 52# happyReduction_204 happyReduction_204 happy_x_1 = case happyOut60 happy_x_1 of { happy_var_1 -> happyIn59 (singleton happy_var_1 )} happyReduce_205 = happySpecReduce_3 52# happyReduction_205 happyReduction_205 happy_x_3 happy_x_2 happy_x_1 = case happyOut59 happy_x_1 of { happy_var_1 -> case happyOut60 happy_x_3 of { happy_var_3 -> happyIn59 (happy_var_1 `snoc` happy_var_3 )}} happyReduce_206 = happySpecReduce_1 53# happyReduction_206 happyReduction_206 happy_x_1 = case happyOut125 happy_x_1 of { happy_var_1 -> happyIn60 ((happy_var_1, Nothing) )} happyReduce_207 = happySpecReduce_3 53# happyReduction_207 happyReduction_207 happy_x_3 happy_x_2 happy_x_1 = case happyOut125 happy_x_1 of { happy_var_1 -> case happyOut121 happy_x_3 of { happy_var_3 -> happyIn60 ((happy_var_1, Just happy_var_3) )}} happyReduce_208 = happyMonadReduce 1# 54# happyReduction_208 happyReduction_208 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CConstQual)} ) (\r -> happyReturn (happyIn61 r)) happyReduce_209 = happyMonadReduce 1# 54# happyReduction_209 happyReduction_209 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CVolatQual)} ) (\r -> happyReturn (happyIn61 r)) happyReduce_210 = happyMonadReduce 1# 54# happyReduction_210 happyReduction_210 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CRestrQual)} ) (\r -> happyReturn (happyIn61 r)) happyReduce_211 = happyMonadReduce 1# 54# happyReduction_211 happyReduction_211 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CInlineQual)} ) (\r -> happyReturn (happyIn61 r)) happyReduce_212 = happySpecReduce_2 55# happyReduction_212 happyReduction_212 happy_x_2 happy_x_1 = case happyOut126 happy_x_1 of { happy_var_1 -> case happyOut61 happy_x_2 of { happy_var_2 -> happyIn62 (reverseList (map CAttrQual happy_var_1) `snoc` happy_var_2 )}} happyReduce_213 = happySpecReduce_2 55# happyReduction_213 happyReduction_213 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut61 happy_x_2 of { happy_var_2 -> happyIn62 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_214 = happySpecReduce_3 55# happyReduction_214 happyReduction_214 happy_x_3 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut61 happy_x_3 of { happy_var_3 -> happyIn62 ((happy_var_1 `rappend` map CAttrQual happy_var_2) `snoc` happy_var_3 )}}} happyReduce_215 = happySpecReduce_1 56# happyReduction_215 happyReduction_215 happy_x_1 = case happyOut72 happy_x_1 of { happy_var_1 -> happyIn63 (happy_var_1 )} happyReduce_216 = happySpecReduce_1 56# happyReduction_216 happyReduction_216 happy_x_1 = case happyOut65 happy_x_1 of { happy_var_1 -> happyIn63 (happy_var_1 )} happyReduce_217 = happySpecReduce_0 57# happyReduction_217 happyReduction_217 = happyIn64 (Nothing ) happyReduce_218 = happyReduce 4# 57# happyReduction_218 happyReduction_218 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut123 happy_x_3 of { happy_var_3 -> happyIn64 (Just happy_var_3 ) `HappyStk` happyRest} happyReduce_219 = happySpecReduce_1 58# happyReduction_219 happyReduction_219 happy_x_1 = case happyOut69 happy_x_1 of { happy_var_1 -> happyIn65 (happy_var_1 )} happyReduce_220 = happySpecReduce_1 58# happyReduction_220 happyReduction_220 happy_x_1 = case happyOut66 happy_x_1 of { happy_var_1 -> happyIn65 (happy_var_1 )} happyReduce_221 = happyMonadReduce 1# 59# happyReduction_221 happyReduction_221 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> ( withNodeInfo happy_var_1 $ mkVarDeclr happy_var_1)} ) (\r -> happyReturn (happyIn66 r)) happyReduce_222 = happyMonadReduce 2# 59# happyReduction_222 happyReduction_222 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> case happyOut85 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ \at -> happy_var_2 (mkVarDeclr happy_var_1 at))}} ) (\r -> happyReturn (happyIn66 r)) happyReduce_223 = happySpecReduce_1 59# happyReduction_223 happyReduction_223 happy_x_1 = case happyOut67 happy_x_1 of { happy_var_1 -> happyIn66 (happy_var_1 )} happyReduce_224 = happySpecReduce_1 60# happyReduction_224 happyReduction_224 happy_x_1 = case happyOut68 happy_x_1 of { happy_var_1 -> happyIn67 (happy_var_1 )} happyReduce_225 = happyMonadReduce 2# 60# happyReduction_225 happyReduction_225 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut66 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_2 [])}} ) (\r -> happyReturn (happyIn67 r)) happyReduce_226 = happyMonadReduce 3# 60# happyReduction_226 happyReduction_226 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut66 happy_x_3 of { happy_var_3 -> ( withAttribute happy_var_1 happy_var_2 $ ptrDeclr happy_var_3 [])}}} ) (\r -> happyReturn (happyIn67 r)) happyReduce_227 = happyMonadReduce 3# 60# happyReduction_227 happyReduction_227 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut66 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_3 (reverse happy_var_2))}}} ) (\r -> happyReturn (happyIn67 r)) happyReduce_228 = happyMonadReduce 4# 60# happyReduction_228 happyReduction_228 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut127 happy_x_3 of { happy_var_3 -> case happyOut66 happy_x_4 of { happy_var_4 -> ( withAttribute happy_var_1 happy_var_3 $ ptrDeclr happy_var_4 (reverse happy_var_2))}}}} ) (\r -> happyReturn (happyIn67 r)) happyReduce_229 = happySpecReduce_3 61# happyReduction_229 happyReduction_229 happy_x_3 happy_x_2 happy_x_1 = case happyOut67 happy_x_2 of { happy_var_2 -> happyIn68 (happy_var_2 )} happyReduce_230 = happyReduce 4# 61# happyReduction_230 happyReduction_230 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut67 happy_x_2 of { happy_var_2 -> case happyOut85 happy_x_4 of { happy_var_4 -> happyIn68 (happy_var_4 happy_var_2 ) `HappyStk` happyRest}} happyReduce_231 = happyReduce 4# 61# happyReduction_231 happyReduction_231 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut67 happy_x_3 of { happy_var_3 -> happyIn68 (appendDeclrAttrs happy_var_2 happy_var_3 ) `HappyStk` happyRest}} happyReduce_232 = happyReduce 5# 61# happyReduction_232 happyReduction_232 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut67 happy_x_3 of { happy_var_3 -> case happyOut85 happy_x_5 of { happy_var_5 -> happyIn68 (appendDeclrAttrs happy_var_2 (happy_var_5 happy_var_3) ) `HappyStk` happyRest}}} happyReduce_233 = happySpecReduce_1 62# happyReduction_233 happyReduction_233 happy_x_1 = case happyOut70 happy_x_1 of { happy_var_1 -> happyIn69 (happy_var_1 )} happyReduce_234 = happyMonadReduce 4# 62# happyReduction_234 happyReduction_234 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut71 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_3 [])}} ) (\r -> happyReturn (happyIn69 r)) happyReduce_235 = happyMonadReduce 5# 62# happyReduction_235 happyReduction_235 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut71 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_4 (reverse happy_var_2))}}} ) (\r -> happyReturn (happyIn69 r)) happyReduce_236 = happyMonadReduce 6# 62# happyReduction_236 happyReduction_236 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut127 happy_x_3 of { happy_var_3 -> case happyOut71 happy_x_5 of { happy_var_5 -> ( withAttribute happy_var_1 happy_var_3 $ ptrDeclr happy_var_5 (reverse happy_var_2))}}}} ) (\r -> happyReturn (happyIn69 r)) happyReduce_237 = happyMonadReduce 2# 62# happyReduction_237 happyReduction_237 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut69 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_2 [])}} ) (\r -> happyReturn (happyIn69 r)) happyReduce_238 = happyMonadReduce 3# 62# happyReduction_238 happyReduction_238 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut69 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_3 (reverse happy_var_2))}}} ) (\r -> happyReturn (happyIn69 r)) happyReduce_239 = happyMonadReduce 4# 62# happyReduction_239 happyReduction_239 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut127 happy_x_3 of { happy_var_3 -> case happyOut69 happy_x_4 of { happy_var_4 -> ( withAttribute happy_var_1 happy_var_3 $ ptrDeclr happy_var_4 (reverse happy_var_2))}}}} ) (\r -> happyReturn (happyIn69 r)) happyReduce_240 = happySpecReduce_3 63# happyReduction_240 happyReduction_240 happy_x_3 happy_x_2 happy_x_1 = case happyOut69 happy_x_2 of { happy_var_2 -> happyIn70 (happy_var_2 )} happyReduce_241 = happyReduce 4# 63# happyReduction_241 happyReduction_241 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut71 happy_x_2 of { happy_var_2 -> case happyOut85 happy_x_3 of { happy_var_3 -> happyIn70 (happy_var_3 happy_var_2 ) `HappyStk` happyRest}} happyReduce_242 = happyReduce 4# 63# happyReduction_242 happyReduction_242 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut69 happy_x_2 of { happy_var_2 -> case happyOut85 happy_x_4 of { happy_var_4 -> happyIn70 (happy_var_4 happy_var_2 ) `HappyStk` happyRest}} happyReduce_243 = happyMonadReduce 1# 64# happyReduction_243 happyReduction_243 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> ( withNodeInfo happy_var_1 $ mkVarDeclr happy_var_1)} ) (\r -> happyReturn (happyIn71 r)) happyReduce_244 = happySpecReduce_3 64# happyReduction_244 happyReduction_244 happy_x_3 happy_x_2 happy_x_1 = case happyOut71 happy_x_2 of { happy_var_2 -> happyIn71 (happy_var_2 )} happyReduce_245 = happySpecReduce_1 65# happyReduction_245 happyReduction_245 happy_x_1 = case happyOut73 happy_x_1 of { happy_var_1 -> happyIn72 (happy_var_1 )} happyReduce_246 = happySpecReduce_1 65# happyReduction_246 happyReduction_246 happy_x_1 = case happyOut75 happy_x_1 of { happy_var_1 -> happyIn72 (happy_var_1 )} happyReduce_247 = happySpecReduce_1 66# happyReduction_247 happyReduction_247 happy_x_1 = case happyOut74 happy_x_1 of { happy_var_1 -> happyIn73 (happy_var_1 )} happyReduce_248 = happyMonadReduce 2# 66# happyReduction_248 happyReduction_248 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut72 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_2 [])}} ) (\r -> happyReturn (happyIn73 r)) happyReduce_249 = happyMonadReduce 3# 66# happyReduction_249 happyReduction_249 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut72 happy_x_3 of { happy_var_3 -> ( withAttribute happy_var_1 happy_var_2 $ ptrDeclr happy_var_3 [])}}} ) (\r -> happyReturn (happyIn73 r)) happyReduce_250 = happyMonadReduce 3# 66# happyReduction_250 happyReduction_250 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut72 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_3 (reverse happy_var_2))}}} ) (\r -> happyReturn (happyIn73 r)) happyReduce_251 = happyMonadReduce 4# 66# happyReduction_251 happyReduction_251 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut127 happy_x_3 of { happy_var_3 -> case happyOut72 happy_x_4 of { happy_var_4 -> ( withAttribute happy_var_1 happy_var_3 $ ptrDeclr happy_var_4 (reverse happy_var_2))}}}} ) (\r -> happyReturn (happyIn73 r)) happyReduce_252 = happySpecReduce_2 67# happyReduction_252 happyReduction_252 happy_x_2 happy_x_1 = case happyOut75 happy_x_1 of { happy_var_1 -> case happyOut85 happy_x_2 of { happy_var_2 -> happyIn74 (happy_var_2 happy_var_1 )}} happyReduce_253 = happySpecReduce_3 67# happyReduction_253 happyReduction_253 happy_x_3 happy_x_2 happy_x_1 = case happyOut73 happy_x_2 of { happy_var_2 -> happyIn74 (happy_var_2 )} happyReduce_254 = happyReduce 4# 67# happyReduction_254 happyReduction_254 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut73 happy_x_2 of { happy_var_2 -> case happyOut85 happy_x_4 of { happy_var_4 -> happyIn74 (happy_var_4 happy_var_2 ) `HappyStk` happyRest}} happyReduce_255 = happyReduce 4# 67# happyReduction_255 happyReduction_255 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut73 happy_x_3 of { happy_var_3 -> happyIn74 (appendDeclrAttrs happy_var_2 happy_var_3 ) `HappyStk` happyRest}} happyReduce_256 = happyReduce 5# 67# happyReduction_256 happyReduction_256 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut73 happy_x_3 of { happy_var_3 -> case happyOut85 happy_x_5 of { happy_var_5 -> happyIn74 (appendDeclrAttrs happy_var_2 (happy_var_5 happy_var_3) ) `HappyStk` happyRest}}} happyReduce_257 = happyMonadReduce 1# 68# happyReduction_257 happyReduction_257 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> ( withNodeInfo happy_var_1 $ mkVarDeclr happy_var_1)} ) (\r -> happyReturn (happyIn75 r)) happyReduce_258 = happySpecReduce_3 68# happyReduction_258 happyReduction_258 happy_x_3 happy_x_2 happy_x_1 = case happyOut75 happy_x_2 of { happy_var_2 -> happyIn75 (happy_var_2 )} happyReduce_259 = happyReduce 4# 68# happyReduction_259 happyReduction_259 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut75 happy_x_3 of { happy_var_3 -> happyIn75 (appendDeclrAttrs happy_var_2 happy_var_3 ) `HappyStk` happyRest}} happyReduce_260 = happySpecReduce_1 69# happyReduction_260 happyReduction_260 happy_x_1 = case happyOut77 happy_x_1 of { happy_var_1 -> happyIn76 (reverseDeclr happy_var_1 )} happyReduce_261 = happySpecReduce_1 70# happyReduction_261 happyReduction_261 happy_x_1 = case happyOut78 happy_x_1 of { happy_var_1 -> happyIn77 (happy_var_1 )} happyReduce_262 = happyMonadReduce 2# 70# happyReduction_262 happyReduction_262 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut77 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_2 [])}} ) (\r -> happyReturn (happyIn77 r)) happyReduce_263 = happyMonadReduce 3# 70# happyReduction_263 happyReduction_263 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut77 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_3 (reverse happy_var_2))}}} ) (\r -> happyReturn (happyIn77 r)) happyReduce_264 = happyMonadReduce 4# 71# happyReduction_264 happyReduction_264 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut75 happy_x_1 of { happy_var_1 -> case happyOut82 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ funDeclr happy_var_1 (Left $ reverse happy_var_3) [])}} ) (\r -> happyReturn (happyIn78 r)) happyReduce_265 = happySpecReduce_3 71# happyReduction_265 happyReduction_265 happy_x_3 happy_x_2 happy_x_1 = case happyOut77 happy_x_2 of { happy_var_2 -> happyIn78 (happy_var_2 )} happyReduce_266 = happyReduce 4# 71# happyReduction_266 happyReduction_266 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut77 happy_x_2 of { happy_var_2 -> case happyOut85 happy_x_4 of { happy_var_4 -> happyIn78 (happy_var_4 happy_var_2 ) `HappyStk` happyRest}} happyReduce_267 = happySpecReduce_0 72# happyReduction_267 happyReduction_267 = happyIn79 (([], False) ) happyReduce_268 = happySpecReduce_1 72# happyReduction_268 happyReduction_268 happy_x_1 = case happyOut80 happy_x_1 of { happy_var_1 -> happyIn79 ((reverse happy_var_1, False) )} happyReduce_269 = happySpecReduce_3 72# happyReduction_269 happyReduction_269 happy_x_3 happy_x_2 happy_x_1 = case happyOut80 happy_x_1 of { happy_var_1 -> happyIn79 ((reverse happy_var_1, True) )} happyReduce_270 = happySpecReduce_1 73# happyReduction_270 happyReduction_270 happy_x_1 = case happyOut81 happy_x_1 of { happy_var_1 -> happyIn80 (singleton happy_var_1 )} happyReduce_271 = happySpecReduce_3 73# happyReduction_271 happyReduction_271 happy_x_3 happy_x_2 happy_x_1 = case happyOut80 happy_x_1 of { happy_var_1 -> case happyOut81 happy_x_3 of { happy_var_3 -> happyIn80 (happy_var_1 `snoc` happy_var_3 )}} happyReduce_272 = happyMonadReduce 1# 74# happyReduction_272 happyReduction_272 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [])} ) (\r -> happyReturn (happyIn81 r)) happyReduce_273 = happyMonadReduce 2# 74# happyReduction_273 happyReduction_273 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut84 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_274 = happyMonadReduce 3# 74# happyReduction_274 happyReduction_274 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr $! appendDeclrAttrs happy_var_3 happy_var_2), Nothing, Nothing)])}}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_275 = happyMonadReduce 3# 74# happyReduction_275 happyReduction_275 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut37 happy_x_1 of { happy_var_1 -> case happyOut66 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr $! appendDeclrAttrs happy_var_3 happy_var_2), Nothing, Nothing)])}}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_276 = happyMonadReduce 1# 74# happyReduction_276 happyReduction_276 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDecl (reverse happy_var_1) [])} ) (\r -> happyReturn (happyIn81 r)) happyReduce_277 = happyMonadReduce 2# 74# happyReduction_277 happyReduction_277 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut84 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CDecl (reverse happy_var_1) [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_278 = happyMonadReduce 3# 74# happyReduction_278 happyReduction_278 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut38 happy_x_1 of { happy_var_1 -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CDecl (reverse happy_var_1) [(Just (reverseDeclr $! appendDeclrAttrs happy_var_3 happy_var_2), Nothing, Nothing)])}}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_279 = happyMonadReduce 1# 74# happyReduction_279 happyReduction_279 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [])} ) (\r -> happyReturn (happyIn81 r)) happyReduce_280 = happyMonadReduce 2# 74# happyReduction_280 happyReduction_280 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut84 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_281 = happyMonadReduce 3# 74# happyReduction_281 happyReduction_281 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr $! appendDeclrAttrs happy_var_3 happy_var_2), Nothing, Nothing)])}}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_282 = happyMonadReduce 3# 74# happyReduction_282 happyReduction_282 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut66 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr $! appendDeclrAttrs happy_var_3 happy_var_2), Nothing, Nothing)])}}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_283 = happyMonadReduce 1# 74# happyReduction_283 happyReduction_283 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDecl (liftTypeQuals happy_var_1) [])} ) (\r -> happyReturn (happyIn81 r)) happyReduce_284 = happyMonadReduce 2# 74# happyReduction_284 happyReduction_284 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CDecl (liftTypeQuals happy_var_1 ++ liftCAttrs happy_var_2) [])}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_285 = happyMonadReduce 2# 74# happyReduction_285 happyReduction_285 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut84 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CDecl (liftTypeQuals happy_var_1) [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_286 = happyMonadReduce 3# 74# happyReduction_286 happyReduction_286 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CDecl (liftTypeQuals happy_var_1) [(Just (reverseDeclr$ appendDeclrAttrs happy_var_3 happy_var_2), Nothing, Nothing)])}}} ) (\r -> happyReturn (happyIn81 r)) happyReduce_287 = happySpecReduce_1 75# happyReduction_287 happyReduction_287 happy_x_1 = case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> happyIn82 (singleton happy_var_1 )} happyReduce_288 = happySpecReduce_3 75# happyReduction_288 happyReduction_288 happy_x_3 happy_x_2 happy_x_1 = case happyOut82 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_3 of { (CTokIdent _ happy_var_3) -> happyIn82 (happy_var_1 `snoc` happy_var_3 )}} happyReduce_289 = happyMonadReduce 1# 76# happyReduction_289 happyReduction_289 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [])} ) (\r -> happyReturn (happyIn83 r)) happyReduce_290 = happyMonadReduce 2# 76# happyReduction_290 happyReduction_290 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut41 happy_x_1 of { happy_var_1 -> case happyOut84 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CDecl happy_var_1 [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])}} ) (\r -> happyReturn (happyIn83 r)) happyReduce_291 = happyMonadReduce 2# 76# happyReduction_291 happyReduction_291 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CDecl (liftTypeQuals happy_var_1 ++ liftCAttrs happy_var_2) [])}} ) (\r -> happyReturn (happyIn83 r)) happyReduce_292 = happyMonadReduce 2# 76# happyReduction_292 happyReduction_292 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut62 happy_x_1 of { happy_var_1 -> case happyOut84 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CDecl (liftTypeQuals happy_var_1) [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])}} ) (\r -> happyReturn (happyIn83 r)) happyReduce_293 = happySpecReduce_1 77# happyReduction_293 happyReduction_293 happy_x_1 = case happyOut88 happy_x_1 of { happy_var_1 -> happyIn84 (happy_var_1 )} happyReduce_294 = happySpecReduce_1 77# happyReduction_294 happyReduction_294 happy_x_1 = case happyOut89 happy_x_1 of { happy_var_1 -> happyIn84 (happy_var_1 )} happyReduce_295 = happySpecReduce_1 77# happyReduction_295 happyReduction_295 happy_x_1 = case happyOut85 happy_x_1 of { happy_var_1 -> happyIn84 (happy_var_1 emptyDeclr )} happyReduce_296 = happySpecReduce_1 78# happyReduction_296 happyReduction_296 happy_x_1 = case happyOut86 happy_x_1 of { happy_var_1 -> happyIn85 (happy_var_1 )} happyReduce_297 = happyMonadReduce 3# 78# happyReduction_297 happyReduction_297 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut79 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ \at declr -> case happy_var_2 of (params, variadic) -> funDeclr declr (Right (params,variadic)) [] at)}} ) (\r -> happyReturn (happyIn85 r)) happyReduce_298 = happySpecReduce_1 79# happyReduction_298 happyReduction_298 happy_x_1 = case happyOut87 happy_x_1 of { happy_var_1 -> happyIn86 (happy_var_1 )} happyReduce_299 = happySpecReduce_2 79# happyReduction_299 happyReduction_299 happy_x_2 happy_x_1 = case happyOut86 happy_x_1 of { happy_var_1 -> case happyOut87 happy_x_2 of { happy_var_2 -> happyIn86 (\decl -> happy_var_2 (happy_var_1 decl) )}} happyReduce_300 = happyMonadReduce 3# 80# happyReduction_300 happyReduction_300 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut120 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ \at declr -> arrDeclr declr [] False False happy_var_2 at)}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_301 = happyMonadReduce 4# 80# happyReduction_301 happyReduction_301 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut120 happy_x_3 of { happy_var_3 -> ( withAttributePF happy_var_1 happy_var_2 $ \at declr -> arrDeclr declr [] False False happy_var_3 at)}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_302 = happyMonadReduce 4# 80# happyReduction_302 happyReduction_302 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut120 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ \at declr -> arrDeclr declr (reverse happy_var_2) False False happy_var_3 at)}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_303 = happyMonadReduce 5# 80# happyReduction_303 happyReduction_303 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut127 happy_x_3 of { happy_var_3 -> case happyOut120 happy_x_4 of { happy_var_4 -> ( withAttributePF happy_var_1 happy_var_3 $ \at declr -> arrDeclr declr (reverse happy_var_2) False False happy_var_4 at)}}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_304 = happyMonadReduce 5# 80# happyReduction_304 happyReduction_304 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_3 of { happy_var_3 -> case happyOut115 happy_x_4 of { happy_var_4 -> ( withAttributePF happy_var_1 happy_var_3 $ \at declr -> arrDeclr declr [] False True (Just happy_var_4) at)}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_305 = happyMonadReduce 6# 80# happyReduction_305 happyReduction_305 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_3 of { happy_var_3 -> case happyOut126 happy_x_4 of { happy_var_4 -> case happyOut115 happy_x_5 of { happy_var_5 -> ( withAttributePF happy_var_1 happy_var_4 $ \at declr -> arrDeclr declr (reverse happy_var_3) False True (Just happy_var_5) at)}}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_306 = happyMonadReduce 7# 80# happyReduction_306 happyReduction_306 (happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> case happyOut126 happy_x_5 of { happy_var_5 -> case happyOut115 happy_x_6 of { happy_var_6 -> ( withAttributePF happy_var_1 (happy_var_3 ++ happy_var_5) $ \at declr -> arrDeclr declr (reverse happy_var_2) False True (Just happy_var_6) at)}}}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_307 = happyMonadReduce 4# 80# happyReduction_307 happyReduction_307 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withAttributePF happy_var_1 happy_var_3 $ \at declr -> arrDeclr declr [] True False Nothing at)}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_308 = happyMonadReduce 5# 80# happyReduction_308 happyReduction_308 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_4 of { happy_var_4 -> ( withAttributePF happy_var_1 (happy_var_2 ++ happy_var_4) $ \at declr -> arrDeclr declr [] True False Nothing at)}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_309 = happyMonadReduce 5# 80# happyReduction_309 happyReduction_309 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_4 of { happy_var_4 -> ( withAttributePF happy_var_1 happy_var_4 $ \at declr -> arrDeclr declr (reverse happy_var_2) True False Nothing at)}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_310 = happyMonadReduce 6# 80# happyReduction_310 happyReduction_310 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut127 happy_x_3 of { happy_var_3 -> case happyOut126 happy_x_5 of { happy_var_5 -> ( withAttributePF happy_var_1 (happy_var_3 ++ happy_var_5) $ \at declr -> arrDeclr declr (reverse happy_var_2) True False Nothing at)}}}} ) (\r -> happyReturn (happyIn87 r)) happyReduce_311 = happyMonadReduce 1# 81# happyReduction_311 happyReduction_311 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ ptrDeclr emptyDeclr [])} ) (\r -> happyReturn (happyIn88 r)) happyReduce_312 = happyMonadReduce 3# 81# happyReduction_312 happyReduction_312 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> ( withAttribute happy_var_1 happy_var_3 $ ptrDeclr emptyDeclr (reverse happy_var_2))}}} ) (\r -> happyReturn (happyIn88 r)) happyReduce_313 = happyMonadReduce 2# 81# happyReduction_313 happyReduction_313 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut84 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_2 [])}} ) (\r -> happyReturn (happyIn88 r)) happyReduce_314 = happyMonadReduce 3# 81# happyReduction_314 happyReduction_314 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut62 happy_x_2 of { happy_var_2 -> case happyOut84 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ ptrDeclr happy_var_3 (reverse happy_var_2))}}} ) (\r -> happyReturn (happyIn88 r)) happyReduce_315 = happyMonadReduce 2# 81# happyReduction_315 happyReduction_315 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> ( withAttribute happy_var_1 happy_var_2 $ ptrDeclr emptyDeclr [])}} ) (\r -> happyReturn (happyIn88 r)) happyReduce_316 = happyMonadReduce 3# 81# happyReduction_316 happyReduction_316 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut84 happy_x_3 of { happy_var_3 -> ( withAttribute happy_var_1 happy_var_2 $ ptrDeclr happy_var_3 [])}}} ) (\r -> happyReturn (happyIn88 r)) happyReduce_317 = happySpecReduce_3 82# happyReduction_317 happyReduction_317 happy_x_3 happy_x_2 happy_x_1 = case happyOut88 happy_x_2 of { happy_var_2 -> happyIn89 (happy_var_2 )} happyReduce_318 = happySpecReduce_3 82# happyReduction_318 happyReduction_318 happy_x_3 happy_x_2 happy_x_1 = case happyOut89 happy_x_2 of { happy_var_2 -> happyIn89 (happy_var_2 )} happyReduce_319 = happySpecReduce_3 82# happyReduction_319 happyReduction_319 happy_x_3 happy_x_2 happy_x_1 = case happyOut85 happy_x_2 of { happy_var_2 -> happyIn89 (happy_var_2 emptyDeclr )} happyReduce_320 = happyReduce 4# 82# happyReduction_320 happyReduction_320 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut88 happy_x_2 of { happy_var_2 -> case happyOut85 happy_x_4 of { happy_var_4 -> happyIn89 (happy_var_4 happy_var_2 ) `HappyStk` happyRest}} happyReduce_321 = happyReduce 4# 82# happyReduction_321 happyReduction_321 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut88 happy_x_3 of { happy_var_3 -> happyIn89 (appendDeclrAttrs happy_var_2 happy_var_3 ) `HappyStk` happyRest}} happyReduce_322 = happyReduce 4# 82# happyReduction_322 happyReduction_322 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut89 happy_x_3 of { happy_var_3 -> happyIn89 (appendDeclrAttrs happy_var_2 happy_var_3 ) `HappyStk` happyRest}} happyReduce_323 = happyReduce 4# 82# happyReduction_323 happyReduction_323 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut85 happy_x_3 of { happy_var_3 -> happyIn89 (appendDeclrAttrs happy_var_2 (happy_var_3 emptyDeclr) ) `HappyStk` happyRest}} happyReduce_324 = happyReduce 5# 82# happyReduction_324 happyReduction_324 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut127 happy_x_2 of { happy_var_2 -> case happyOut88 happy_x_3 of { happy_var_3 -> case happyOut85 happy_x_5 of { happy_var_5 -> happyIn89 (appendDeclrAttrs happy_var_2 (happy_var_5 happy_var_3) ) `HappyStk` happyRest}}} happyReduce_325 = happySpecReduce_2 82# happyReduction_325 happyReduction_325 happy_x_2 happy_x_1 = case happyOut89 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn89 (appendDeclrAttrs happy_var_2 happy_var_1 )}} happyReduce_326 = happyMonadReduce 1# 83# happyReduction_326 happyReduction_326 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut115 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CInitExpr happy_var_1)} ) (\r -> happyReturn (happyIn90 r)) happyReduce_327 = happyMonadReduce 3# 83# happyReduction_327 happyReduction_327 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut92 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CInitList (reverse happy_var_2))}} ) (\r -> happyReturn (happyIn90 r)) happyReduce_328 = happyMonadReduce 4# 83# happyReduction_328 happyReduction_328 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut92 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CInitList (reverse happy_var_2))}} ) (\r -> happyReturn (happyIn90 r)) happyReduce_329 = happySpecReduce_0 84# happyReduction_329 happyReduction_329 = happyIn91 (Nothing ) happyReduce_330 = happySpecReduce_2 84# happyReduction_330 happyReduction_330 happy_x_2 happy_x_1 = case happyOut90 happy_x_2 of { happy_var_2 -> happyIn91 (Just happy_var_2 )} happyReduce_331 = happySpecReduce_0 85# happyReduction_331 happyReduction_331 = happyIn92 (empty ) happyReduce_332 = happySpecReduce_1 85# happyReduction_332 happyReduction_332 happy_x_1 = case happyOut90 happy_x_1 of { happy_var_1 -> happyIn92 (singleton ([],happy_var_1) )} happyReduce_333 = happySpecReduce_2 85# happyReduction_333 happyReduction_333 happy_x_2 happy_x_1 = case happyOut93 happy_x_1 of { happy_var_1 -> case happyOut90 happy_x_2 of { happy_var_2 -> happyIn92 (singleton (happy_var_1,happy_var_2) )}} happyReduce_334 = happySpecReduce_3 85# happyReduction_334 happyReduction_334 happy_x_3 happy_x_2 happy_x_1 = case happyOut92 happy_x_1 of { happy_var_1 -> case happyOut90 happy_x_3 of { happy_var_3 -> happyIn92 (happy_var_1 `snoc` ([],happy_var_3) )}} happyReduce_335 = happyReduce 4# 85# happyReduction_335 happyReduction_335 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut92 happy_x_1 of { happy_var_1 -> case happyOut93 happy_x_3 of { happy_var_3 -> case happyOut90 happy_x_4 of { happy_var_4 -> happyIn92 (happy_var_1 `snoc` (happy_var_3,happy_var_4) ) `HappyStk` happyRest}}} happyReduce_336 = happySpecReduce_2 86# happyReduction_336 happyReduction_336 happy_x_2 happy_x_1 = case happyOut94 happy_x_1 of { happy_var_1 -> happyIn93 (reverse happy_var_1 )} happyReduce_337 = happyMonadReduce 2# 86# happyReduction_337 happyReduction_337 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut125 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ \at -> [CMemberDesig happy_var_1 at])} ) (\r -> happyReturn (happyIn93 r)) happyReduce_338 = happySpecReduce_1 86# happyReduction_338 happyReduction_338 happy_x_1 = case happyOut96 happy_x_1 of { happy_var_1 -> happyIn93 ([happy_var_1] )} happyReduce_339 = happySpecReduce_1 87# happyReduction_339 happyReduction_339 happy_x_1 = case happyOut95 happy_x_1 of { happy_var_1 -> happyIn94 (singleton happy_var_1 )} happyReduce_340 = happySpecReduce_2 87# happyReduction_340 happyReduction_340 happy_x_2 happy_x_1 = case happyOut94 happy_x_1 of { happy_var_1 -> case happyOut95 happy_x_2 of { happy_var_2 -> happyIn94 (happy_var_1 `snoc` happy_var_2 )}} happyReduce_341 = happyMonadReduce 3# 88# happyReduction_341 happyReduction_341 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut121 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CArrDesig happy_var_2)}} ) (\r -> happyReturn (happyIn95 r)) happyReduce_342 = happyMonadReduce 2# 88# happyReduction_342 happyReduction_342 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut125 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CMemberDesig happy_var_2)}} ) (\r -> happyReturn (happyIn95 r)) happyReduce_343 = happySpecReduce_1 88# happyReduction_343 happyReduction_343 happy_x_1 = case happyOut96 happy_x_1 of { happy_var_1 -> happyIn95 (happy_var_1 )} happyReduce_344 = happyMonadReduce 5# 89# happyReduction_344 happyReduction_344 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut121 happy_x_2 of { happy_var_2 -> case happyOut121 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CRangeDesig happy_var_2 happy_var_4)}}} ) (\r -> happyReturn (happyIn96 r)) happyReduce_345 = happyMonadReduce 1# 90# happyReduction_345 happyReduction_345 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> ( withNodeInfo happy_var_1 $ CVar happy_var_1)} ) (\r -> happyReturn (happyIn97 r)) happyReduce_346 = happySpecReduce_1 90# happyReduction_346 happyReduction_346 happy_x_1 = case happyOut122 happy_x_1 of { happy_var_1 -> happyIn97 (CConst happy_var_1 )} happyReduce_347 = happySpecReduce_1 90# happyReduction_347 happyReduction_347 happy_x_1 = case happyOut123 happy_x_1 of { happy_var_1 -> happyIn97 (CConst (liftStrLit happy_var_1) )} happyReduce_348 = happySpecReduce_3 90# happyReduction_348 happyReduction_348 happy_x_3 happy_x_2 happy_x_1 = case happyOut117 happy_x_2 of { happy_var_2 -> happyIn97 (happy_var_2 )} happyReduce_349 = happyMonadReduce 3# 90# happyReduction_349 happyReduction_349 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut14 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CStatExpr happy_var_2)}} ) (\r -> happyReturn (happyIn97 r)) happyReduce_350 = happyMonadReduce 6# 90# happyReduction_350 happyReduction_350 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut115 happy_x_3 of { happy_var_3 -> case happyOut83 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CBuiltinExpr . CBuiltinVaArg happy_var_3 happy_var_5)}}} ) (\r -> happyReturn (happyIn97 r)) happyReduce_351 = happyMonadReduce 6# 90# happyReduction_351 happyReduction_351 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut83 happy_x_3 of { happy_var_3 -> case happyOut98 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CBuiltinExpr . CBuiltinOffsetOf happy_var_3 (reverse happy_var_5))}}} ) (\r -> happyReturn (happyIn97 r)) happyReduce_352 = happyMonadReduce 6# 90# happyReduction_352 happyReduction_352 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut83 happy_x_3 of { happy_var_3 -> case happyOut83 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CBuiltinExpr . CBuiltinTypesCompatible happy_var_3 happy_var_5)}}} ) (\r -> happyReturn (happyIn97 r)) happyReduce_353 = happyMonadReduce 1# 91# happyReduction_353 happyReduction_353 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut125 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ singleton . CMemberDesig happy_var_1)} ) (\r -> happyReturn (happyIn98 r)) happyReduce_354 = happyMonadReduce 3# 91# happyReduction_354 happyReduction_354 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut98 happy_x_1 of { happy_var_1 -> case happyOut125 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_3 $ (happy_var_1 `snoc`) . CMemberDesig happy_var_3)}} ) (\r -> happyReturn (happyIn98 r)) happyReduce_355 = happyMonadReduce 4# 91# happyReduction_355 happyReduction_355 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut98 happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_3 $ (happy_var_1 `snoc`) . CArrDesig happy_var_3)}} ) (\r -> happyReturn (happyIn98 r)) happyReduce_356 = happySpecReduce_1 92# happyReduction_356 happyReduction_356 happy_x_1 = case happyOut97 happy_x_1 of { happy_var_1 -> happyIn99 (happy_var_1 )} happyReduce_357 = happyMonadReduce 4# 92# happyReduction_357 happyReduction_357 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CIndex happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn99 r)) happyReduce_358 = happyMonadReduce 3# 92# happyReduction_358 happyReduction_358 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CCall happy_var_1 [])} ) (\r -> happyReturn (happyIn99 r)) happyReduce_359 = happyMonadReduce 4# 92# happyReduction_359 happyReduction_359 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> case happyOut100 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CCall happy_var_1 (reverse happy_var_3))}} ) (\r -> happyReturn (happyIn99 r)) happyReduce_360 = happyMonadReduce 3# 92# happyReduction_360 happyReduction_360 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> case happyOut125 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CMember happy_var_1 happy_var_3 False)}} ) (\r -> happyReturn (happyIn99 r)) happyReduce_361 = happyMonadReduce 3# 92# happyReduction_361 happyReduction_361 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> case happyOut125 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CMember happy_var_1 happy_var_3 True)}} ) (\r -> happyReturn (happyIn99 r)) happyReduce_362 = happyMonadReduce 2# 92# happyReduction_362 happyReduction_362 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CUnary CPostIncOp happy_var_1)} ) (\r -> happyReturn (happyIn99 r)) happyReduce_363 = happyMonadReduce 2# 92# happyReduction_363 happyReduction_363 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut99 happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ CUnary CPostDecOp happy_var_1)} ) (\r -> happyReturn (happyIn99 r)) happyReduce_364 = happyMonadReduce 6# 92# happyReduction_364 happyReduction_364 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut83 happy_x_2 of { happy_var_2 -> case happyOut92 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CCompoundLit happy_var_2 (reverse happy_var_5))}}} ) (\r -> happyReturn (happyIn99 r)) happyReduce_365 = happyMonadReduce 7# 92# happyReduction_365 happyReduction_365 (happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut83 happy_x_2 of { happy_var_2 -> case happyOut92 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CCompoundLit happy_var_2 (reverse happy_var_5))}}} ) (\r -> happyReturn (happyIn99 r)) happyReduce_366 = happySpecReduce_1 93# happyReduction_366 happyReduction_366 happy_x_1 = case happyOut115 happy_x_1 of { happy_var_1 -> happyIn100 (singleton happy_var_1 )} happyReduce_367 = happySpecReduce_3 93# happyReduction_367 happyReduction_367 happy_x_3 happy_x_2 happy_x_1 = case happyOut100 happy_x_1 of { happy_var_1 -> case happyOut115 happy_x_3 of { happy_var_3 -> happyIn100 (happy_var_1 `snoc` happy_var_3 )}} happyReduce_368 = happySpecReduce_1 94# happyReduction_368 happyReduction_368 happy_x_1 = case happyOut99 happy_x_1 of { happy_var_1 -> happyIn101 (happy_var_1 )} happyReduce_369 = happyMonadReduce 2# 94# happyReduction_369 happyReduction_369 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut101 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CUnary CPreIncOp happy_var_2)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_370 = happyMonadReduce 2# 94# happyReduction_370 happyReduction_370 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut101 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CUnary CPreDecOp happy_var_2)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_371 = happySpecReduce_2 94# happyReduction_371 happyReduction_371 happy_x_2 happy_x_1 = case happyOut103 happy_x_2 of { happy_var_2 -> happyIn101 (happy_var_2 )} happyReduce_372 = happyMonadReduce 2# 94# happyReduction_372 happyReduction_372 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut102 happy_x_1 of { happy_var_1 -> case happyOut103 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CUnary (unL happy_var_1) happy_var_2)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_373 = happyMonadReduce 2# 94# happyReduction_373 happyReduction_373 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut101 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CSizeofExpr happy_var_2)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_374 = happyMonadReduce 4# 94# happyReduction_374 happyReduction_374 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut83 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CSizeofType happy_var_3)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_375 = happyMonadReduce 2# 94# happyReduction_375 happyReduction_375 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut101 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CAlignofExpr happy_var_2)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_376 = happyMonadReduce 4# 94# happyReduction_376 happyReduction_376 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut83 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CAlignofType happy_var_3)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_377 = happyMonadReduce 2# 94# happyReduction_377 happyReduction_377 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut101 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CComplexReal happy_var_2)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_378 = happyMonadReduce 2# 94# happyReduction_378 happyReduction_378 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut101 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CComplexImag happy_var_2)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_379 = happyMonadReduce 2# 94# happyReduction_379 happyReduction_379 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut125 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ CLabAddrExpr happy_var_2)}} ) (\r -> happyReturn (happyIn101 r)) happyReduce_380 = happySpecReduce_1 95# happyReduction_380 happyReduction_380 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn102 (L CAdrOp (posOf happy_var_1) )} happyReduce_381 = happySpecReduce_1 95# happyReduction_381 happyReduction_381 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn102 (L CIndOp (posOf happy_var_1) )} happyReduce_382 = happySpecReduce_1 95# happyReduction_382 happyReduction_382 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn102 (L CPlusOp (posOf happy_var_1) )} happyReduce_383 = happySpecReduce_1 95# happyReduction_383 happyReduction_383 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn102 (L CMinOp (posOf happy_var_1) )} happyReduce_384 = happySpecReduce_1 95# happyReduction_384 happyReduction_384 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn102 (L CCompOp (posOf happy_var_1) )} happyReduce_385 = happySpecReduce_1 95# happyReduction_385 happyReduction_385 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn102 (L CNegOp (posOf happy_var_1) )} happyReduce_386 = happySpecReduce_1 96# happyReduction_386 happyReduction_386 happy_x_1 = case happyOut101 happy_x_1 of { happy_var_1 -> happyIn103 (happy_var_1 )} happyReduce_387 = happyMonadReduce 4# 96# happyReduction_387 happyReduction_387 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut83 happy_x_2 of { happy_var_2 -> case happyOut103 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CCast happy_var_2 happy_var_4)}}} ) (\r -> happyReturn (happyIn103 r)) happyReduce_388 = happySpecReduce_1 97# happyReduction_388 happyReduction_388 happy_x_1 = case happyOut103 happy_x_1 of { happy_var_1 -> happyIn104 (happy_var_1 )} happyReduce_389 = happyMonadReduce 3# 97# happyReduction_389 happyReduction_389 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut104 happy_x_1 of { happy_var_1 -> case happyOut103 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CMulOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn104 r)) happyReduce_390 = happyMonadReduce 3# 97# happyReduction_390 happyReduction_390 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut104 happy_x_1 of { happy_var_1 -> case happyOut103 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CDivOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn104 r)) happyReduce_391 = happyMonadReduce 3# 97# happyReduction_391 happyReduction_391 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut104 happy_x_1 of { happy_var_1 -> case happyOut103 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CRmdOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn104 r)) happyReduce_392 = happySpecReduce_1 98# happyReduction_392 happyReduction_392 happy_x_1 = case happyOut104 happy_x_1 of { happy_var_1 -> happyIn105 (happy_var_1 )} happyReduce_393 = happyMonadReduce 3# 98# happyReduction_393 happyReduction_393 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut105 happy_x_1 of { happy_var_1 -> case happyOut104 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CAddOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn105 r)) happyReduce_394 = happyMonadReduce 3# 98# happyReduction_394 happyReduction_394 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut105 happy_x_1 of { happy_var_1 -> case happyOut104 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CSubOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn105 r)) happyReduce_395 = happySpecReduce_1 99# happyReduction_395 happyReduction_395 happy_x_1 = case happyOut105 happy_x_1 of { happy_var_1 -> happyIn106 (happy_var_1 )} happyReduce_396 = happyMonadReduce 3# 99# happyReduction_396 happyReduction_396 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut106 happy_x_1 of { happy_var_1 -> case happyOut105 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CShlOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn106 r)) happyReduce_397 = happyMonadReduce 3# 99# happyReduction_397 happyReduction_397 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut106 happy_x_1 of { happy_var_1 -> case happyOut105 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CShrOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn106 r)) happyReduce_398 = happySpecReduce_1 100# happyReduction_398 happyReduction_398 happy_x_1 = case happyOut106 happy_x_1 of { happy_var_1 -> happyIn107 (happy_var_1 )} happyReduce_399 = happyMonadReduce 3# 100# happyReduction_399 happyReduction_399 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut107 happy_x_1 of { happy_var_1 -> case happyOut106 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CLeOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn107 r)) happyReduce_400 = happyMonadReduce 3# 100# happyReduction_400 happyReduction_400 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut107 happy_x_1 of { happy_var_1 -> case happyOut106 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CGrOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn107 r)) happyReduce_401 = happyMonadReduce 3# 100# happyReduction_401 happyReduction_401 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut107 happy_x_1 of { happy_var_1 -> case happyOut106 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CLeqOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn107 r)) happyReduce_402 = happyMonadReduce 3# 100# happyReduction_402 happyReduction_402 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut107 happy_x_1 of { happy_var_1 -> case happyOut106 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CGeqOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn107 r)) happyReduce_403 = happySpecReduce_1 101# happyReduction_403 happyReduction_403 happy_x_1 = case happyOut107 happy_x_1 of { happy_var_1 -> happyIn108 (happy_var_1 )} happyReduce_404 = happyMonadReduce 3# 101# happyReduction_404 happyReduction_404 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut108 happy_x_1 of { happy_var_1 -> case happyOut107 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CEqOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn108 r)) happyReduce_405 = happyMonadReduce 3# 101# happyReduction_405 happyReduction_405 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut108 happy_x_1 of { happy_var_1 -> case happyOut107 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CNeqOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn108 r)) happyReduce_406 = happySpecReduce_1 102# happyReduction_406 happyReduction_406 happy_x_1 = case happyOut108 happy_x_1 of { happy_var_1 -> happyIn109 (happy_var_1 )} happyReduce_407 = happyMonadReduce 3# 102# happyReduction_407 happyReduction_407 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut109 happy_x_1 of { happy_var_1 -> case happyOut108 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CAndOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn109 r)) happyReduce_408 = happySpecReduce_1 103# happyReduction_408 happyReduction_408 happy_x_1 = case happyOut109 happy_x_1 of { happy_var_1 -> happyIn110 (happy_var_1 )} happyReduce_409 = happyMonadReduce 3# 103# happyReduction_409 happyReduction_409 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut110 happy_x_1 of { happy_var_1 -> case happyOut109 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CXorOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn110 r)) happyReduce_410 = happySpecReduce_1 104# happyReduction_410 happyReduction_410 happy_x_1 = case happyOut110 happy_x_1 of { happy_var_1 -> happyIn111 (happy_var_1 )} happyReduce_411 = happyMonadReduce 3# 104# happyReduction_411 happyReduction_411 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut111 happy_x_1 of { happy_var_1 -> case happyOut110 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary COrOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn111 r)) happyReduce_412 = happySpecReduce_1 105# happyReduction_412 happyReduction_412 happy_x_1 = case happyOut111 happy_x_1 of { happy_var_1 -> happyIn112 (happy_var_1 )} happyReduce_413 = happyMonadReduce 3# 105# happyReduction_413 happyReduction_413 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut112 happy_x_1 of { happy_var_1 -> case happyOut111 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CLndOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn112 r)) happyReduce_414 = happySpecReduce_1 106# happyReduction_414 happyReduction_414 happy_x_1 = case happyOut112 happy_x_1 of { happy_var_1 -> happyIn113 (happy_var_1 )} happyReduce_415 = happyMonadReduce 3# 106# happyReduction_415 happyReduction_415 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut113 happy_x_1 of { happy_var_1 -> case happyOut112 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CBinary CLorOp happy_var_1 happy_var_3)}} ) (\r -> happyReturn (happyIn113 r)) happyReduce_416 = happySpecReduce_1 107# happyReduction_416 happyReduction_416 happy_x_1 = case happyOut113 happy_x_1 of { happy_var_1 -> happyIn114 (happy_var_1 )} happyReduce_417 = happyMonadReduce 5# 107# happyReduction_417 happyReduction_417 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut113 happy_x_1 of { happy_var_1 -> case happyOut117 happy_x_3 of { happy_var_3 -> case happyOut114 happy_x_5 of { happy_var_5 -> ( withNodeInfo happy_var_1 $ CCond happy_var_1 (Just happy_var_3) happy_var_5)}}} ) (\r -> happyReturn (happyIn114 r)) happyReduce_418 = happyMonadReduce 4# 107# happyReduction_418 happyReduction_418 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut113 happy_x_1 of { happy_var_1 -> case happyOut114 happy_x_4 of { happy_var_4 -> ( withNodeInfo happy_var_1 $ CCond happy_var_1 Nothing happy_var_4)}} ) (\r -> happyReturn (happyIn114 r)) happyReduce_419 = happySpecReduce_1 108# happyReduction_419 happyReduction_419 happy_x_1 = case happyOut114 happy_x_1 of { happy_var_1 -> happyIn115 (happy_var_1 )} happyReduce_420 = happyMonadReduce 3# 108# happyReduction_420 happyReduction_420 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut101 happy_x_1 of { happy_var_1 -> case happyOut116 happy_x_2 of { happy_var_2 -> case happyOut115 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ CAssign (unL happy_var_2) happy_var_1 happy_var_3)}}} ) (\r -> happyReturn (happyIn115 r)) happyReduce_421 = happySpecReduce_1 109# happyReduction_421 happyReduction_421 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CAssignOp (posOf happy_var_1) )} happyReduce_422 = happySpecReduce_1 109# happyReduction_422 happyReduction_422 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CMulAssOp (posOf happy_var_1) )} happyReduce_423 = happySpecReduce_1 109# happyReduction_423 happyReduction_423 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CDivAssOp (posOf happy_var_1) )} happyReduce_424 = happySpecReduce_1 109# happyReduction_424 happyReduction_424 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CRmdAssOp (posOf happy_var_1) )} happyReduce_425 = happySpecReduce_1 109# happyReduction_425 happyReduction_425 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CAddAssOp (posOf happy_var_1) )} happyReduce_426 = happySpecReduce_1 109# happyReduction_426 happyReduction_426 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CSubAssOp (posOf happy_var_1) )} happyReduce_427 = happySpecReduce_1 109# happyReduction_427 happyReduction_427 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CShlAssOp (posOf happy_var_1) )} happyReduce_428 = happySpecReduce_1 109# happyReduction_428 happyReduction_428 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CShrAssOp (posOf happy_var_1) )} happyReduce_429 = happySpecReduce_1 109# happyReduction_429 happyReduction_429 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CAndAssOp (posOf happy_var_1) )} happyReduce_430 = happySpecReduce_1 109# happyReduction_430 happyReduction_430 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L CXorAssOp (posOf happy_var_1) )} happyReduce_431 = happySpecReduce_1 109# happyReduction_431 happyReduction_431 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn116 (L COrAssOp (posOf happy_var_1) )} happyReduce_432 = happySpecReduce_1 110# happyReduction_432 happyReduction_432 happy_x_1 = case happyOut115 happy_x_1 of { happy_var_1 -> happyIn117 (happy_var_1 )} happyReduce_433 = happyMonadReduce 3# 110# happyReduction_433 happyReduction_433 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut115 happy_x_1 of { happy_var_1 -> case happyOut118 happy_x_3 of { happy_var_3 -> ( let es = reverse happy_var_3 in withNodeInfo es $ CComma (happy_var_1:es))}} ) (\r -> happyReturn (happyIn117 r)) happyReduce_434 = happySpecReduce_1 111# happyReduction_434 happyReduction_434 happy_x_1 = case happyOut115 happy_x_1 of { happy_var_1 -> happyIn118 (singleton happy_var_1 )} happyReduce_435 = happySpecReduce_3 111# happyReduction_435 happyReduction_435 happy_x_3 happy_x_2 happy_x_1 = case happyOut118 happy_x_1 of { happy_var_1 -> case happyOut115 happy_x_3 of { happy_var_3 -> happyIn118 (happy_var_1 `snoc` happy_var_3 )}} happyReduce_436 = happySpecReduce_0 112# happyReduction_436 happyReduction_436 = happyIn119 (Nothing ) happyReduce_437 = happySpecReduce_1 112# happyReduction_437 happyReduction_437 happy_x_1 = case happyOut117 happy_x_1 of { happy_var_1 -> happyIn119 (Just happy_var_1 )} happyReduce_438 = happySpecReduce_0 113# happyReduction_438 happyReduction_438 = happyIn120 (Nothing ) happyReduce_439 = happySpecReduce_1 113# happyReduction_439 happyReduction_439 happy_x_1 = case happyOut115 happy_x_1 of { happy_var_1 -> happyIn120 (Just happy_var_1 )} happyReduce_440 = happySpecReduce_1 114# happyReduction_440 happyReduction_440 happy_x_1 = case happyOut114 happy_x_1 of { happy_var_1 -> happyIn121 (happy_var_1 )} happyReduce_441 = happyMonadReduce 1# 115# happyReduction_441 happyReduction_441 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ case happy_var_1 of CTokILit _ i -> CIntConst i)} ) (\r -> happyReturn (happyIn122 r)) happyReduce_442 = happyMonadReduce 1# 115# happyReduction_442 happyReduction_442 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ case happy_var_1 of CTokCLit _ c -> CCharConst c)} ) (\r -> happyReturn (happyIn122 r)) happyReduce_443 = happyMonadReduce 1# 115# happyReduction_443 happyReduction_443 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ case happy_var_1 of CTokFLit _ f -> CFloatConst f)} ) (\r -> happyReturn (happyIn122 r)) happyReduce_444 = happyMonadReduce 1# 116# happyReduction_444 happyReduction_444 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ case happy_var_1 of CTokSLit _ s -> CStrLit s)} ) (\r -> happyReturn (happyIn123 r)) happyReduce_445 = happyMonadReduce 2# 116# happyReduction_445 happyReduction_445 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut124 happy_x_2 of { happy_var_2 -> ( withNodeInfo happy_var_1 $ case happy_var_1 of CTokSLit _ s -> CStrLit (concatCStrings (s : reverse happy_var_2)))}} ) (\r -> happyReturn (happyIn123 r)) happyReduce_446 = happySpecReduce_1 117# happyReduction_446 happyReduction_446 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn124 (case happy_var_1 of CTokSLit _ s -> singleton s )} happyReduce_447 = happySpecReduce_2 117# happyReduction_447 happyReduction_447 happy_x_2 happy_x_1 = case happyOut124 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> happyIn124 (case happy_var_2 of CTokSLit _ s -> happy_var_1 `snoc` s )}} happyReduce_448 = happySpecReduce_1 118# happyReduction_448 happyReduction_448 happy_x_1 = case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> happyIn125 (happy_var_1 )} happyReduce_449 = happySpecReduce_1 118# happyReduction_449 happyReduction_449 happy_x_1 = case happyOutTok happy_x_1 of { (CTokTyIdent _ happy_var_1) -> happyIn125 (happy_var_1 )} happyReduce_450 = happySpecReduce_0 119# happyReduction_450 happyReduction_450 = happyIn126 ([] ) happyReduce_451 = happySpecReduce_1 119# happyReduction_451 happyReduction_451 happy_x_1 = case happyOut127 happy_x_1 of { happy_var_1 -> happyIn126 (happy_var_1 )} happyReduce_452 = happySpecReduce_1 120# happyReduction_452 happyReduction_452 happy_x_1 = case happyOut128 happy_x_1 of { happy_var_1 -> happyIn127 (happy_var_1 )} happyReduce_453 = happySpecReduce_2 120# happyReduction_453 happyReduction_453 happy_x_2 happy_x_1 = case happyOut127 happy_x_1 of { happy_var_1 -> case happyOut128 happy_x_2 of { happy_var_2 -> happyIn127 (happy_var_1 ++ happy_var_2 )}} happyReduce_454 = happyReduce 6# 121# happyReduction_454 happyReduction_454 (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 happyOut129 happy_x_4 of { happy_var_4 -> happyIn128 (reverse happy_var_4 ) `HappyStk` happyRest} happyReduce_455 = happySpecReduce_1 122# happyReduction_455 happyReduction_455 happy_x_1 = case happyOut130 happy_x_1 of { happy_var_1 -> happyIn129 (case happy_var_1 of Nothing -> empty; Just attr -> singleton attr )} happyReduce_456 = happySpecReduce_3 122# happyReduction_456 happyReduction_456 happy_x_3 happy_x_2 happy_x_1 = case happyOut129 happy_x_1 of { happy_var_1 -> case happyOut130 happy_x_3 of { happy_var_3 -> happyIn129 ((maybe id (flip snoc) happy_var_3) happy_var_1 )}} happyReduce_457 = happySpecReduce_0 123# happyReduction_457 happyReduction_457 = happyIn130 (Nothing ) happyReduce_458 = happyMonadReduce 1# 123# happyReduction_458 happyReduction_458 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> ( withNodeInfo happy_var_1 $ Just . CAttr happy_var_1 [])} ) (\r -> happyReturn (happyIn130 r)) happyReduce_459 = happyMonadReduce 1# 123# happyReduction_459 happyReduction_459 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( withNodeInfo happy_var_1 $ Just . CAttr (internalIdent "const") [])} ) (\r -> happyReturn (happyIn130 r)) happyReduce_460 = happyMonadReduce 4# 123# happyReduction_460 happyReduction_460 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> case happyOut131 happy_x_3 of { happy_var_3 -> ( withNodeInfo happy_var_1 $ Just . CAttr happy_var_1 (reverse happy_var_3))}} ) (\r -> happyReturn (happyIn130 r)) happyReduce_461 = happyMonadReduce 3# 123# happyReduction_461 happyReduction_461 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (CTokIdent _ happy_var_1) -> ( withNodeInfo happy_var_1 $ Just . CAttr happy_var_1 [])} ) (\r -> happyReturn (happyIn130 r)) happyReduce_462 = happySpecReduce_1 124# happyReduction_462 happyReduction_462 happy_x_1 = case happyOut121 happy_x_1 of { happy_var_1 -> happyIn131 (singleton happy_var_1 )} happyReduce_463 = happySpecReduce_3 124# happyReduction_463 happyReduction_463 happy_x_3 happy_x_2 happy_x_1 = case happyOut131 happy_x_1 of { happy_var_1 -> case happyOut121 happy_x_3 of { happy_var_3 -> happyIn131 (happy_var_1 `snoc` happy_var_3 )}} happyNewToken action sts stk = lexC(\tk -> let cont i = happyDoAction i tk action sts stk in case tk of { CTokEof -> happyDoAction 101# tk action sts stk; CTokLParen _ -> cont 1#; CTokRParen _ -> cont 2#; CTokLBracket _ -> cont 3#; CTokRBracket _ -> cont 4#; CTokArrow _ -> cont 5#; CTokDot _ -> cont 6#; CTokExclam _ -> cont 7#; CTokTilde _ -> cont 8#; CTokInc _ -> cont 9#; CTokDec _ -> cont 10#; CTokPlus _ -> cont 11#; CTokMinus _ -> cont 12#; CTokStar _ -> cont 13#; CTokSlash _ -> cont 14#; CTokPercent _ -> cont 15#; CTokAmper _ -> cont 16#; CTokShiftL _ -> cont 17#; CTokShiftR _ -> cont 18#; CTokLess _ -> cont 19#; CTokLessEq _ -> cont 20#; CTokHigh _ -> cont 21#; CTokHighEq _ -> cont 22#; CTokEqual _ -> cont 23#; CTokUnequal _ -> cont 24#; CTokHat _ -> cont 25#; CTokBar _ -> cont 26#; CTokAnd _ -> cont 27#; CTokOr _ -> cont 28#; CTokQuest _ -> cont 29#; CTokColon _ -> cont 30#; CTokAssign _ -> cont 31#; CTokPlusAss _ -> cont 32#; CTokMinusAss _ -> cont 33#; CTokStarAss _ -> cont 34#; CTokSlashAss _ -> cont 35#; CTokPercAss _ -> cont 36#; CTokAmpAss _ -> cont 37#; CTokHatAss _ -> cont 38#; CTokBarAss _ -> cont 39#; CTokSLAss _ -> cont 40#; CTokSRAss _ -> cont 41#; CTokComma _ -> cont 42#; CTokSemic _ -> cont 43#; CTokLBrace _ -> cont 44#; CTokRBrace _ -> cont 45#; CTokEllipsis _ -> cont 46#; CTokAlignof _ -> cont 47#; CTokAsm _ -> cont 48#; CTokAuto _ -> cont 49#; CTokBreak _ -> cont 50#; CTokBool _ -> cont 51#; CTokCase _ -> cont 52#; CTokChar _ -> cont 53#; CTokConst _ -> cont 54#; CTokContinue _ -> cont 55#; CTokComplex _ -> cont 56#; CTokDefault _ -> cont 57#; CTokDo _ -> cont 58#; CTokDouble _ -> cont 59#; CTokElse _ -> cont 60#; CTokEnum _ -> cont 61#; CTokExtern _ -> cont 62#; CTokFloat _ -> cont 63#; CTokFor _ -> cont 64#; CTokGoto _ -> cont 65#; CTokIf _ -> cont 66#; CTokInline _ -> cont 67#; CTokInt _ -> cont 68#; CTokLong _ -> cont 69#; CTokLabel _ -> cont 70#; CTokRegister _ -> cont 71#; CTokRestrict _ -> cont 72#; CTokReturn _ -> cont 73#; CTokShort _ -> cont 74#; CTokSigned _ -> cont 75#; CTokSizeof _ -> cont 76#; CTokStatic _ -> cont 77#; CTokStruct _ -> cont 78#; CTokSwitch _ -> cont 79#; CTokTypedef _ -> cont 80#; CTokTypeof _ -> cont 81#; CTokThread _ -> cont 82#; CTokUnion _ -> cont 83#; CTokUnsigned _ -> cont 84#; CTokVoid _ -> cont 85#; CTokVolatile _ -> cont 86#; CTokWhile _ -> cont 87#; CTokCLit _ _ -> cont 88#; CTokILit _ _ -> cont 89#; CTokFLit _ _ -> cont 90#; CTokSLit _ _ -> cont 91#; CTokIdent _ happy_dollar_dollar -> cont 92#; CTokTyIdent _ happy_dollar_dollar -> cont 93#; CTokGnuC GnuCAttrTok _ -> cont 94#; CTokGnuC GnuCExtTok _ -> cont 95#; CTokGnuC GnuCComplexReal _ -> cont 96#; CTokGnuC GnuCComplexImag _ -> cont 97#; CTokGnuC GnuCVaArg _ -> cont 98#; CTokGnuC GnuCOffsetof _ -> cont 99#; CTokGnuC GnuCTyCompat _ -> cont 100#; _ -> happyError' tk }) happyError_ tk = happyError' tk happyThen :: () => P a -> (a -> P b) -> P b happyThen = (>>=) happyReturn :: () => a -> P a happyReturn = (return) happyThen1 = happyThen happyReturn1 :: () => a -> P a happyReturn1 = happyReturn happyError' :: () => CToken -> P a happyError' tk = (\token -> happyError) tk translation_unit = happySomeParser where happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut7 x)) external_declaration = happySomeParser where happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut9 x)) statement = happySomeParser where happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut12 x)) expression = happySomeParser where happySomeParser = happyThen (happyParse 3#) (\x -> happyReturn (happyOut117 x)) happySeq = happyDontSeq -- sometimes it is neccessary to reverse an unreversed list reverseList :: [a] -> Reversed [a] reverseList = Reversed . List.reverse -- We occasionally need things to have a location when they don't naturally -- have one built in as tokens and most AST elements do. -- data Located a = L !a !Position unL :: Located a -> a unL (L a pos) = a instance Pos (Located a) where posOf (L _ pos) = pos -- FIXME: the next 3 inlines here increase the object file size by 70% -- Check whether the speed win is worth it {-# INLINE withNodeInfo #-} withNodeInfo :: Pos node => node -> (NodeInfo -> a) -> P a withNodeInfo node mkAttrNode = do name <- getNewName lastTok <- getSavedToken let firstPos = posOf node let attrs = mkNodeInfo' firstPos (posLenOfTok $! lastTok) name attrs `seq` return (mkAttrNode attrs) {-# INLINE withLength #-} withLength :: NodeInfo -> (NodeInfo -> a) -> P a withLength nodeinfo mkAttrNode = do lastTok <- getSavedToken let firstPos = posOfNode nodeinfo let attrs = mkNodeInfo' firstPos (posLenOfTok $! lastTok) (maybe (error "nameOfNode") id (nameOfNode nodeinfo)) attrs `seq` return (mkAttrNode attrs) data CDeclrR = CDeclrR (Maybe Ident) (Reversed [CDerivedDeclr]) (Maybe CStrLit) [CAttr] NodeInfo reverseDeclr :: CDeclrR -> CDeclr reverseDeclr (CDeclrR ide reversedDDs asmname cattrs at) = CDeclr ide (reverse reversedDDs) asmname cattrs at instance CNode (CDeclrR) where nodeInfo (CDeclrR _ _ _ _ n) = n instance Pos (CDeclrR) where posOf (CDeclrR _ _ _ _ n) = posOf n {-# INLINE withAttribute #-} withAttribute :: Pos node => node -> [CAttr] -> (NodeInfo -> CDeclrR) -> P CDeclrR withAttribute node cattrs mkDeclrNode = do name <- getNewName let attrs = mkNodeInfo (posOf node) name let newDeclr = appendDeclrAttrs cattrs $ mkDeclrNode attrs attrs `seq` newDeclr `seq` return newDeclr -- postfixing variant {-# INLINE withAttributePF #-} withAttributePF :: Pos node => node -> [CAttr] -> (NodeInfo -> CDeclrR -> CDeclrR) -> P (CDeclrR -> CDeclrR) withAttributePF node cattrs mkDeclrCtor = do name <- getNewName let attrs = mkNodeInfo (posOf node) name let newDeclr = appendDeclrAttrs cattrs . mkDeclrCtor attrs attrs `seq` newDeclr `seq` return newDeclr -- add top level attributes for a declarator. -- -- In the following example -- -- > int declr1, __attribute__((a1)) * __attribute__((a2)) y() __asm__("$" "y") __attribute__((a3)); -- -- the attributes `a1' and `a3' are top-level attributes for y. -- The (pseudo)-AST for the second declarator is -- -- > CDeclr "y" -- > [CFunDeclr ..., CPtrDeclr __attribute__((a2)) ... ] -- > (asm "$y") -- > [__attribute__((a1)), __attribute__((a3)) ] -- -- So assembler names and preceeding and trailing attributes are recorded in object declarator. -- appendObjAttrs :: [CAttr] -> CDeclr -> CDeclr appendObjAttrs newAttrs (CDeclr ident indirections asmname cAttrs at) = CDeclr ident indirections asmname (cAttrs ++ newAttrs) at appendObjAttrsR :: [CAttr] -> CDeclrR -> CDeclrR appendObjAttrsR newAttrs (CDeclrR ident indirections asmname cAttrs at) = CDeclrR ident indirections asmname (cAttrs ++ newAttrs) at setAsmName :: Maybe CStrLit -> CDeclrR -> P CDeclrR setAsmName mAsmName (CDeclrR ident indirections oldName cattrs at) = case combineName mAsmName oldName of Left (n1,n2) -> failP (posOf n2) ["Duplicate assembler name: ",showName n1,showName n2] Right newName -> return $ CDeclrR ident indirections newName cattrs at where combineName Nothing Nothing = Right Nothing combineName Nothing oldname@(Just _) = Right oldname combineName newname@(Just _) Nothing = Right newname combineName (Just n1) (Just n2) = Left (n1,n2) showName (CStrLit cstr _) = show cstr withAsmNameAttrs :: (Maybe CStrLit, [CAttr]) -> CDeclrR -> P CDeclrR withAsmNameAttrs (mAsmName, newAttrs) declr = setAsmName mAsmName (appendObjAttrsR newAttrs declr) appendDeclrAttrs :: [CAttr] -> CDeclrR -> CDeclrR appendDeclrAttrs newAttrs (CDeclrR ident (Reversed []) asmname cattrs at) = CDeclrR ident empty asmname (cattrs ++ newAttrs) at appendDeclrAttrs newAttrs (CDeclrR ident (Reversed (x:xs)) asmname cattrs at) = CDeclrR ident (Reversed (appendAttrs x : xs)) asmname cattrs at where appendAttrs (CPtrDeclr typeQuals at) = CPtrDeclr (typeQuals ++ map CAttrQual newAttrs) at appendAttrs (CArrDeclr typeQuals arraySize at) = CArrDeclr (typeQuals ++ map CAttrQual newAttrs) arraySize at appendAttrs (CFunDeclr parameters cattrs at) = CFunDeclr parameters (cattrs ++ newAttrs) at ptrDeclr :: CDeclrR -> [CTypeQual] -> NodeInfo -> CDeclrR ptrDeclr (CDeclrR ident derivedDeclrs asmname cattrs dat) tyquals at = CDeclrR ident (derivedDeclrs `snoc` CPtrDeclr tyquals at) asmname cattrs dat funDeclr :: CDeclrR -> (Either [Ident] ([CDecl],Bool)) -> [CAttr] -> NodeInfo -> CDeclrR funDeclr (CDeclrR ident derivedDeclrs asmname dcattrs dat) params cattrs at = CDeclrR ident (derivedDeclrs `snoc` CFunDeclr params cattrs at) asmname dcattrs dat arrDeclr :: CDeclrR -> [CTypeQual] -> Bool -> Bool -> Maybe CExpr -> NodeInfo -> CDeclrR arrDeclr (CDeclrR ident derivedDeclrs asmname cattrs dat) tyquals var_sized static_size size_expr_opt at = arr_sz `seq` ( CDeclrR ident (derivedDeclrs `snoc` CArrDeclr tyquals arr_sz at) asmname cattrs dat ) where arr_sz = case size_expr_opt of Just e -> CArrSize static_size e Nothing -> CNoArrSize var_sized liftTypeQuals :: Reversed [CTypeQual] -> [CDeclSpec] liftTypeQuals = map CTypeQual . reverse -- lift CAttrs to DeclSpecs -- liftCAttrs :: [CAttr] -> [CDeclSpec] liftCAttrs = map (CTypeQual . CAttrQual) -- when we parsed (decl_spec_1,...,decl_spec_n,attrs), add the __attributes__s to the declspec list -- needs special care when @decl_spec_n@ is a SUE definition addTrailingAttrs :: Reversed [CDeclSpec] -> [CAttr] -> Reversed [CDeclSpec] addTrailingAttrs declspecs new_attrs = case viewr declspecs of (specs_init, CTypeSpec (CSUType (CStruct tag name (Just def) def_attrs su_node) node)) -> (specs_init `snoc` CTypeSpec (CSUType (CStruct tag name (Just def) (def_attrs ++ new_attrs) su_node) node)) (specs_init, CTypeSpec (CEnumType (CEnum name (Just def) def_attrs e_node) node)) -> (specs_init `snoc` CTypeSpec (CEnumType (CEnum name (Just def) (def_attrs ++ new_attrs) e_node) node)) _ -> declspecs `rappend` (liftCAttrs new_attrs) -- convenient instance, the position of a list of things is the position of -- the first thing in the list -- instance Pos a => Pos [a] where posOf (x:_) = posOf x instance Pos a => Pos (Reversed a) where posOf (Reversed x) = posOf x emptyDeclr :: CDeclrR emptyDeclr = CDeclrR Nothing empty Nothing [] undefNode mkVarDeclr :: Ident -> NodeInfo -> CDeclrR mkVarDeclr ident = CDeclrR (Just ident) empty Nothing [] -- Take the identifiers and use them to update the typedef'ed identifier set -- if the decl is defining a typedef then we add it to the set, -- if it's a var decl then that shadows typedefed identifiers -- doDeclIdent :: [CDeclSpec] -> CDeclrR -> P () doDeclIdent declspecs (CDeclrR mIdent _ _ _ _) = case mIdent of Nothing -> return () Just ident | any iypedef declspecs -> addTypedef ident | otherwise -> shadowTypedef ident where iypedef (CStorageSpec (CTypedef _)) = True iypedef _ = False doFuncParamDeclIdent :: CDeclr -> P () doFuncParamDeclIdent (CDeclr _ (CFunDeclr params _ _ : _) _ _ _) = sequence_ [ case getCDeclrIdent declr of Nothing -> return () Just ident -> shadowTypedef ident | CDecl _ dle _ <- either (const []) fst params , (Just declr, _, _) <- dle ] doFuncParamDeclIdent _ = return () -- extract all identifiers getCDeclrIdent :: CDeclr -> Maybe Ident getCDeclrIdent (CDeclr mIdent _ _ _ _) = mIdent happyError :: P a happyError = parseError -- * public interface -- | @parseC input initialPos@ parses the given preprocessed C-source input and returns the AST or a list of parse errors. parseC :: InputStream -> Position -> Either ParseError CTranslUnit parseC input initialPosition = fmap fst $ execParser translUnitP input initialPosition builtinTypeNames (namesStartingFrom 0) -- | @translUnitP@ provides a parser for a complete C translation unit, i.e. a list of external declarations. translUnitP :: P CTranslUnit translUnitP = translation_unit -- | @extDeclP@ provides a parser for an external (file-scope) declaration extDeclP :: P CExtDecl extDeclP = external_declaration -- | @statementP@ provides a parser for C statements statementP :: P CStat statementP = statement -- | @expressionP@ provides a parser for C expressions expressionP :: P CExpr expressionP = expression {-# LINE 1 "GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp {-# LINE 28 "GenericTemplate.hs" #-} data Happy_IntList = HappyCons Int# Happy_IntList {-# LINE 49 "GenericTemplate.hs" #-} {-# LINE 59 "GenericTemplate.hs" #-} {-# LINE 68 "GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) ----------------------------------------------------------------------------- -- starting the parse happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll ----------------------------------------------------------------------------- -- Accepting the parse -- If the current token is 0#, it means we've just accepted a partial -- parse (a %partial parser). We must ignore the saved token on the top of -- the stack in this case. happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action happyDoAction i tk st = {- nothing -} case action of 0# -> {- nothing -} happyFail i tk st -1# -> {- nothing -} happyAccept i tk st n | (n <# (0# :: Int#)) -> {- nothing -} (happyReduceArr ! rule) i tk st where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) n -> {- nothing -} happyShift new_state i tk st where new_state = (n -# (1# :: Int#)) where off = indexShortOffAddr happyActOffsets st off_i = (off +# i) check = if (off_i >=# (0# :: Int#)) then (indexShortOffAddr happyCheck off_i ==# i) else False action | check = indexShortOffAddr happyTable off_i | otherwise = indexShortOffAddr happyDefActions st {-# LINE 127 "GenericTemplate.hs" #-} indexShortOffAddr (HappyA# arr) off = -- #if __GLASGOW_HASKELL__ > 500 narrow16Int# i -- #elif __GLASGOW_HASKELL__ == 500 intToInt16# i -- #else (i `iShiftL#` 16#) `iShiftRA#` 16# -- #endif where -- #if __GLASGOW_HASKELL__ >= 503 i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) -- #else i = word2Int# ((high `shiftL#` 8#) `or#` low) -- #endif high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) low = int2Word# (ord# (indexCharOffAddr# arr off')) off' = off *# 2# data HappyAddr = HappyA# Addr# ----------------------------------------------------------------------------- -- HappyState data type (not arrays) {-# LINE 170 "GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- Shifting a token happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = let i = (case unsafeCoerce# x of { (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 -# (1# :: Int#)) sts of sts1@((HappyCons (st1@(action)) (_))) -> let r = fn stk in -- it doesn't hurt to always seq here... happyDoSeq r (happyGoto nt j tk st1 sts1 r) happyMonadReduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonadReduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk happyMonad2Reduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk off = indexShortOffAddr happyGotoOffsets st1 off_i = (off +# nt) new_state = indexShortOffAddr happyTable off_i happyDrop 0# l = l happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t happyDropStk 0# l = l happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs ----------------------------------------------------------------------------- -- Moving to a new state after a reduction happyGoto nt j tk st = {- nothing -} happyDoAction j tk new_state where off = indexShortOffAddr happyGotoOffsets st off_i = (off +# nt) new_state = indexShortOffAddr happyTable off_i ----------------------------------------------------------------------------- -- Error recovery (0# is the error token) -- parse error if we are in recovery and we fail again happyFail 0# tk old_st _ stk = -- trace "failing" $ happyError_ tk {- We don't need state discarding for our restricted implementation of "error". In fact, it can cause some bogus parses, so I've disabled it for now --SDM -- discard a state happyFail 0# tk old_st (HappyCons ((action)) (sts)) (saved_tok `HappyStk` _ `HappyStk` stk) = -- trace ("discarding state, depth " ++ show (length stk)) $ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) -} -- Enter error recovery: generate an error token, -- save the old token and carry on. happyFail i tk (action) sts stk = -- trace "entering error recovery" $ happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk) -- Internal happy errors: notHappyAtAll = error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions happyTcHack :: Int# -> a -> a happyTcHack x y = y {-# INLINE happyTcHack #-} ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits -- happySeq = happyDoSeq -- otherwise it emits -- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b happyDontSeq a b = b ----------------------------------------------------------------------------- -- Don't inline any functions from the template. GHC has a nasty habit -- of deciding to inline happyGoto everywhere, which increases the size of -- the generated parser quite a bit. {-# NOINLINE happyDoAction #-} {-# NOINLINE happyTable #-} {-# NOINLINE happyCheck #-} {-# NOINLINE happyActOffsets #-} {-# NOINLINE happyGotoOffsets #-} {-# NOINLINE happyDefActions #-} {-# NOINLINE happyShift #-} {-# NOINLINE happySpecReduce_0 #-} {-# NOINLINE happySpecReduce_1 #-} {-# NOINLINE happySpecReduce_2 #-} {-# NOINLINE happySpecReduce_3 #-} {-# NOINLINE happyReduce #-} {-# NOINLINE happyMonadReduce #-} {-# NOINLINE happyGoto #-} {-# NOINLINE happyFail #-} -- end of Happy Template. haskell-src-exts-1.14.0/Test/examples/EmptyAnn.hs0000644000000000000000000000004512204617765020011 0ustar0000000000000000{-# ANN foo "Hlint: ignore Test4" #-}haskell-src-exts-1.14.0/Test/examples/QQType.hs0000644000000000000000000000025712204617765017446 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, TemplateHaskell, QuasiQuotes #-} module QQType where import Language.Haskell.TH x :: DecsQ x = [d| instance Show $(conT (mkName \"Int\")) |] haskell-src-exts-1.14.0/Test/examples/ConstraintKinds.hs0000644000000000000000000000021412204617765021371 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} class Foo a where type Bar a type Bazable a b = (Bar a ~ Maybe b) baz :: Bazable a b => a -> a baz = id haskell-src-exts-1.14.0/Test/examples/TypeFunctions.hs0000644000000000000000000000017612204617765021075 0ustar0000000000000000{-# LANGUAGE TypeFamilies, KindSignatures #-} data Id = Id type family Rep (f :: * -> *) x :: * type instance Rep Id x = x haskell-src-exts-1.14.0/Test/examples/Testing.hs0000644000000000000000000000007612204617765017677 0ustar0000000000000000{-# LINE 5 "templates\GenericTemplate.hs" #-} main = return ()haskell-src-exts-1.14.0/Test/examples/DataHeadParen.hs0000644000000000000000000000012212204617765020673 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} module DataHeadParen where data (a1 :< a2) = Foo haskell-src-exts-1.14.0/Test/examples/HexPrec.hs0000644000000000000000000000011212204617765017607 0ustar0000000000000000module HexPrec where (%%) :: Int -> Int -> Int a %% b = 0 infixl 0x02 %%haskell-src-exts-1.14.0/Test/examples/NPlusK.hs0000644000000000000000000000005512204617765017433 0ustar0000000000000000{-# LANGUAGE NPlusKPatterns #-} f (n+3) = n haskell-src-exts-1.14.0/Test/examples/IndentedWhereBlock.hs0000644000000000000000000000030412204617765021754 0ustar0000000000000000module Graph where countryLookUp :: String -> Graph -> Maybe Int countryLookUp country graph = indexOf country graph where indexOf :: String -> Graph -> Maybe Int indexOf _ Empty = Nothing haskell-src-exts-1.14.0/Test/examples/EmptyContext.hs0000644000000000000000000000002712204617765020721 0ustar0000000000000000happyThen :: () => P a haskell-src-exts-1.14.0/Test/examples/ClassInstType.hs0000644000000000000000000000073712204617765021033 0ustar0000000000000000module ClassInstType where class Dir d where localDir :: d -> IO FilePath instance Dir Directory where localDir (Local f) = return f localDir (Darcs {url=url,darcsVersion=Patch patch,subDirectory=subDir}) = do tmp <- createTempDir 0 "haskelld" darcsOut <- runDarcsCommand tmp "get" ["--lazy","--to-match","hash "++ patch,url,"fs"] print darcsOut let (ExitSuccess,"",out) = darcsOut print out return $ tmp "fs" subDir type URL = String haskell-src-exts-1.14.0/Test/examples/RCategory.lhs0000644000000000000000000000215512204617765020335 0ustar0000000000000000\begin{code} {-# LANGUAGE TypeFamilies, ConstraintKinds #-} module Control.RCategory where import qualified Prelude import GHC.Prim infixr 9 . infixr 1 >>>, <<< -- | A class for categories. -- id and (.) must form a monoid. class RCategory cat where type RCategoryCtxt cat a b :: Constraint -- | the identity morphism id :: RCategoryCtxt cat a a => cat a a -- | morphism composition (.) :: (RCategoryCtxt cat b c, RCategoryCtxt cat a b, RCategoryCtxt cat a c) => cat b c -> cat a b -> cat a c {-# RULES "identity/left" forall p . id . p = p "identity/right" forall p . p . id = p #-} instance RCategory (->) where type RCategoryCtxt (->) a a = () id = Prelude.id (.) = (Prelude..) -- | Right-to-left composition (<<<) :: (RCategoryCtxt cat a c, RCategoryCtxt cat a b, RCategoryCtxt cat b c, RCategory cat) => cat b c -> cat a b -> cat a c (<<<) = (.) -- | Left-to-right composition (>>>) :: (RCategoryCtxt cat a c, RCategoryCtxt cat a b, RCategoryCtxt cat b c, RCategory cat) => cat a b -> cat b c -> cat a c f >>> g = g . f \end{code}haskell-src-exts-1.14.0/Test/examples/NegPrimWordLiteral.hs0000644000000000000000000000010212204617765021762 0ustar0000000000000000{-# LANGUAGE MagicHash #-} dummyWord = W# (-0x8000000000000000##) haskell-src-exts-1.14.0/Test/examples/Directory.hs0000644000000000000000000007246112204617765020235 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface, NondecreasingIndentation #-} ----------------------------------------------------------------------------- -- | -- Module : System.Directory -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- System-independent interface to directory manipulation. -- ----------------------------------------------------------------------------- module System.Directory ( -- $intro -- * Actions on directories createDirectory -- :: FilePath -> IO () , createDirectoryIfMissing -- :: Bool -> FilePath -> IO () , removeDirectory -- :: FilePath -> IO () , removeDirectoryRecursive -- :: FilePath -> IO () , renameDirectory -- :: FilePath -> FilePath -> IO () , getDirectoryContents -- :: FilePath -> IO [FilePath] , getCurrentDirectory -- :: IO FilePath , setCurrentDirectory -- :: FilePath -> IO () -- * Pre-defined directories , getHomeDirectory , getAppUserDataDirectory , getUserDocumentsDirectory , getTemporaryDirectory -- * Actions on files , removeFile -- :: FilePath -> IO () , renameFile -- :: FilePath -> FilePath -> IO () , copyFile -- :: FilePath -> FilePath -> IO () , canonicalizePath , makeRelativeToCurrentDirectory , findExecutable -- * Existence tests , doesFileExist -- :: FilePath -> IO Bool , doesDirectoryExist -- :: FilePath -> IO Bool -- * Permissions -- $permissions , Permissions( Permissions, readable, -- :: Permissions -> Bool writable, -- :: Permissions -> Bool executable, -- :: Permissions -> Bool searchable -- :: Permissions -> Bool ) , getPermissions -- :: FilePath -> IO Permissions , setPermissions -- :: FilePath -> Permissions -> IO () , copyPermissions -- * Timestamps , getModificationTime -- :: FilePath -> IO ClockTime ) where import Prelude hiding ( catch ) import qualified Prelude import Control.Monad (guard) import System.Environment ( getEnv ) import System.FilePath import System.IO import System.IO.Error hiding ( catch, try ) import Control.Monad ( when, unless ) import Control.Exception.Base import Foreign import Foreign.C {-# CFILES cbits/directory.c #-} import System.Time ( ClockTime(..) ) import GHC.IO.Exception ( IOException(..), IOErrorType(..), ioException ) import System.Posix.Types import System.Posix.Internals import qualified System.Win32 as Win32 {- $intro A directory contains a series of entries, each of which is a named reference to a file system object (file, directory etc.). Some entries may be hidden, inaccessible, or have some administrative function (e.g. `.' or `..' under POSIX ), but in this standard all such entries are considered to form part of the directory contents. Entries in sub-directories are not, however, considered to form part of the directory contents. Each file system object is referenced by a /path/. There is normally at least one absolute path to each file system object. In some operating systems, it may also be possible to have paths which are relative to the current directory. -} ----------------------------------------------------------------------------- -- Permissions {- $permissions The 'Permissions' type is used to record whether certain operations are permissible on a file\/directory. 'getPermissions' and 'setPermissions' get and set these permissions, respectively. Permissions apply both to files and directories. For directories, the executable field will be 'False', and for files the searchable field will be 'False'. Note that directories may be searchable without being readable, if permission has been given to use them as part of a path, but not to examine the directory contents. Note that to change some, but not all permissions, a construct on the following lines must be used. > makeReadable f = do > p <- getPermissions f > setPermissions f (p {readable = True}) -} data Permissions = Permissions { readable, writable, executable, searchable :: Bool } deriving (Eq, Ord, Read, Show) {- |The 'getPermissions' operation returns the permissions for the file or directory. The operation may fail with: * 'isPermissionError' if the user is not permitted to access the permissions; or * 'isDoesNotExistError' if the file or directory does not exist. -} getPermissions :: FilePath -> IO Permissions getPermissions name = do withFilePath name $ \s -> do -- stat() does a better job of guessing the permissions on Windows -- than access() does. e.g. for execute permission, it looks at the -- filename extension :-) -- -- I tried for a while to do this properly, using the Windows security API, -- and eventually gave up. getPermissions is a flawed API anyway. -- SimonM allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1_ "getPermissions" $ c_stat s p_stat mode <- st_mode p_stat let usr_read = mode .&. s_IRUSR let usr_write = mode .&. s_IWUSR let usr_exec = mode .&. s_IXUSR let is_dir = mode .&. s_IFDIR return ( Permissions { readable = usr_read /= 0, writable = usr_write /= 0, executable = is_dir == 0 && usr_exec /= 0, searchable = is_dir /= 0 && usr_exec /= 0 } ) {- |The 'setPermissions' operation sets the permissions for the file or directory. The operation may fail with: * 'isPermissionError' if the user is not permitted to set the permissions; or * 'isDoesNotExistError' if the file or directory does not exist. -} setPermissions :: FilePath -> Permissions -> IO () setPermissions name (Permissions r w e s) = do allocaBytes sizeof_stat $ \ p_stat -> do withFilePath name $ \p_name -> do throwErrnoIfMinus1_ "setPermissions" $ do c_stat p_name p_stat mode <- st_mode p_stat let mode1 = modifyBit r mode s_IRUSR let mode2 = modifyBit w mode1 s_IWUSR let mode3 = modifyBit (e || s) mode2 s_IXUSR c_wchmod p_name mode3 where modifyBit :: Bool -> CMode -> CMode -> CMode modifyBit False m b = m .&. (complement b) modifyBit True m b = m .|. b foreign import ccall unsafe "_wchmod" c_wchmod :: CWString -> CMode -> IO CInt copyPermissions :: FilePath -> FilePath -> IO () copyPermissions source dest = do allocaBytes sizeof_stat $ \ p_stat -> do withFilePath source $ \p_source -> do withFilePath dest $ \p_dest -> do throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat mode <- st_mode p_stat throwErrnoIfMinus1_ "copyPermissions" $ c_wchmod p_dest mode ----------------------------------------------------------------------------- -- Implementation {- |@'createDirectory' dir@ creates a new directory @dir@ which is initially empty, or as near to empty as the operating system allows. The operation may fail with: * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES]@ * 'isAlreadyExistsError' \/ 'AlreadyExists' The operand refers to a directory that already exists. @ [EEXIST]@ * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' The operand is not a valid directory name. @[ENAMETOOLONG, ELOOP]@ * 'NoSuchThing' There is no path to the directory. @[ENOENT, ENOTDIR]@ * 'ResourceExhausted' Insufficient resources (virtual memory, process file descriptors, physical disk space, etc.) are available to perform the operation. @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ * 'InappropriateType' The path refers to an existing non-directory object. @[EEXIST]@ -} createDirectory :: FilePath -> IO () createDirectory path = do Win32.createDirectory path Nothing -- | @'createDirectoryIfMissing' parents dir@ creates a new directory -- @dir@ if it doesn\'t exist. If the first argument is 'True' -- the function will also create all parent directories if they are missing. createDirectoryIfMissing :: Bool -- ^ Create its parents too? -> FilePath -- ^ The path to the directory you want to make -> IO () createDirectoryIfMissing create_parents path0 | create_parents = createDirs (parents path0) | otherwise = createDirs (take 1 (parents path0)) where parents = reverse . scanl1 () . splitDirectories . normalise createDirs [] = return () createDirs (dir:[]) = createDir dir throw createDirs (dir:dirs) = createDir dir $ \_ -> do createDirs dirs createDir dir throw createDir :: FilePath -> (IOException -> IO ()) -> IO () createDir dir notExistHandler = do r <- try $ createDirectory dir case (r :: Either IOException ()) of Right () -> return () Left e | isDoesNotExistError e -> notExistHandler e -- createDirectory (and indeed POSIX mkdir) does not distinguish -- between a dir already existing and a file already existing. So we -- check for it here. Unfortunately there is a slight race condition -- here, but we think it is benign. It could report an exeption in -- the case that the dir did exist but another process deletes the -- directory and creates a file in its place before we can check -- that the directory did indeed exist. | isAlreadyExistsError e -> (do withFileStatus "createDirectoryIfMissing" dir $ \st -> do isDir <- isDirectory st if isDir then return () else throw e ) `catch` ((\_ -> return ()) :: IOException -> IO ()) | otherwise -> throw e {- | @'removeDirectory' dir@ removes an existing directory /dir/. The implementation may specify additional constraints which must be satisfied before a directory can be removed (e.g. the directory has to be empty, or may not be in use by other processes). It is not legal for an implementation to partially remove a directory unless the entire directory is removed. A conformant implementation need not support directory removal in all situations (e.g. removal of the root directory). The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. EIO * 'InvalidArgument' The operand is not a valid directory name. [ENAMETOOLONG, ELOOP] * 'isDoesNotExistError' \/ 'NoSuchThing' The directory does not exist. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES, EPERM]@ * 'UnsatisfiedConstraints' Implementation-dependent constraints are not satisfied. @[EBUSY, ENOTEMPTY, EEXIST]@ * 'UnsupportedOperation' The implementation does not support removal in this situation. @[EINVAL]@ * 'InappropriateType' The operand refers to an existing non-directory object. @[ENOTDIR]@ -} removeDirectory :: FilePath -> IO () removeDirectory path = Win32.removeDirectory path -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/ -- together with its content and all subdirectories. Be careful, -- if the directory contains symlinks, the function will follow them. removeDirectoryRecursive :: FilePath -> IO () removeDirectoryRecursive startLoc = do cont <- getDirectoryContents startLoc sequence_ [rm (startLoc x) | x <- cont, x /= "." && x /= ".."] removeDirectory startLoc where rm :: FilePath -> IO () rm f = do temp <- try (removeFile f) case temp of Left e -> do isDir <- doesDirectoryExist f -- If f is not a directory, re-throw the error unless isDir $ throw (e :: SomeException) removeDirectoryRecursive f Right _ -> return () {- |'removeFile' /file/ removes the directory entry for an existing file /file/, where /file/ is not itself a directory. The implementation may specify additional constraints which must be satisfied before a file can be removed (e.g. the file may not be in use by other processes). The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' The operand is not a valid file name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The file does not exist. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES, EPERM]@ * 'UnsatisfiedConstraints' Implementation-dependent constraints are not satisfied. @[EBUSY]@ * 'InappropriateType' The operand refers to an existing directory. @[EPERM, EINVAL]@ -} removeFile :: FilePath -> IO () removeFile path = Win32.deleteFile path {- |@'renameDirectory' old new@ changes the name of an existing directory from /old/ to /new/. If the /new/ directory already exists, it is atomically replaced by the /old/ directory. If the /new/ directory is neither the /old/ directory nor an alias of the /old/ directory, it is removed as if by 'removeDirectory'. A conformant implementation need not support renaming directories in all situations (e.g. renaming to an existing directory, or across different physical devices), but the constraints must be documented. On Win32 platforms, @renameDirectory@ fails if the /new/ directory already exists. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' Either operand is not a valid directory name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The original directory does not exist, or there is no path to the target. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES, EPERM]@ * 'ResourceExhausted' Insufficient resources are available to perform the operation. @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ * 'UnsatisfiedConstraints' Implementation-dependent constraints are not satisfied. @[EBUSY, ENOTEMPTY, EEXIST]@ * 'UnsupportedOperation' The implementation does not support renaming in this situation. @[EINVAL, EXDEV]@ * 'InappropriateType' Either path refers to an existing non-directory object. @[ENOTDIR, EISDIR]@ -} renameDirectory :: FilePath -> FilePath -> IO () renameDirectory opath npath = do -- XXX this test isn't performed atomically with the following rename -- ToDo: use Win32 API withFileStatus "renameDirectory" opath $ \st -> do is_dir <- isDirectory st if (not is_dir) then ioException (ioeSetErrorString (mkIOError InappropriateType "renameDirectory" Nothing (Just opath)) "not a directory") else do Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING {- |@'renameFile' old new@ changes the name of an existing file system object from /old/ to /new/. If the /new/ object already exists, it is atomically replaced by the /old/ object. Neither path may refer to an existing directory. A conformant implementation need not support renaming files in all situations (e.g. renaming across different physical devices), but the constraints must be documented. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' Either operand is not a valid file name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The original file does not exist, or there is no path to the target. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES, EPERM]@ * 'ResourceExhausted' Insufficient resources are available to perform the operation. @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ * 'UnsatisfiedConstraints' Implementation-dependent constraints are not satisfied. @[EBUSY]@ * 'UnsupportedOperation' The implementation does not support renaming in this situation. @[EXDEV]@ * 'InappropriateType' Either path refers to an existing directory. @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@ -} renameFile :: FilePath -> FilePath -> IO () renameFile opath npath = do -- XXX this test isn't performed atomically with the following rename -- ToDo: use Win32 API withFileOrSymlinkStatus "renameFile" opath $ \st -> do is_dir <- isDirectory st if is_dir then ioException (ioeSetErrorString (mkIOError InappropriateType "renameFile" Nothing (Just opath)) "is a directory") else do Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING {- |@'copyFile' old new@ copies the existing file from /old/ to /new/. If the /new/ file already exists, it is atomically replaced by the /old/ file. Neither path may refer to an existing directory. The permissions of /old/ are copied to /new/, if possible. -} copyFile :: FilePath -> FilePath -> IO () copyFile fromFPath toFPath = copy `Prelude.catch` (\exc -> throw $ ioeSetLocation exc "copyFile") where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom -> bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) -> do allocaBytes bufferSize $ copyContents hFrom hTmp hClose hTmp ignoreIOExceptions $ copyPermissions fromFPath tmpFPath renameFile tmpFPath toFPath openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp" cleanTmp (tmpFPath, hTmp) = do ignoreIOExceptions $ hClose hTmp ignoreIOExceptions $ removeFile tmpFPath bufferSize = 1024 copyContents hFrom hTo buffer = do count <- hGetBuf hFrom buffer bufferSize when (count > 0) $ do hPutBuf hTo buffer count copyContents hFrom hTo buffer ignoreIOExceptions io = io `catch` ioExceptionIgnorer ioExceptionIgnorer :: IOException -> IO () ioExceptionIgnorer _ = return () -- | Given path referring to a file or directory, returns a -- canonicalized path, with the intent that two paths referring -- to the same file\/directory will map to the same canonicalized -- path. Note that it is impossible to guarantee that the -- implication (same file\/dir \<=\> same canonicalizedPath) holds -- in either direction: this function can make only a best-effort -- attempt. canonicalizePath :: FilePath -> IO FilePath canonicalizePath fpath = do path <- Win32.getFullPathName fpath return (normalise path) -- normalise does more stuff, like upper-casing the drive letter -- | 'makeRelative' the current directory. makeRelativeToCurrentDirectory :: FilePath -> IO FilePath makeRelativeToCurrentDirectory x = do cur <- getCurrentDirectory return $ makeRelative cur x -- | Given an executable file name, searches for such file in the -- directories listed in system PATH. The returned value is the path -- to the found executable or Nothing if an executable with the given -- name was not found. For example (findExecutable \"ghc\") gives you -- the path to GHC. -- -- The path returned by 'findExecutable' corresponds to the -- program that would be executed by 'System.Process.createProcess' -- when passed the same string (as a RawCommand, not a ShellCommand). -- -- On Windows, 'findExecutable' calls the Win32 function 'SearchPath', -- which may search other places before checking the directories in -- @PATH@. Where it actually searches depends on registry settings, -- but notably includes the directory containing the current -- executable. See -- for more -- details. -- findExecutable :: String -> IO (Maybe FilePath) findExecutable binary = Win32.searchPath Nothing binary ('.':exeExtension) {- |@'getDirectoryContents' dir@ returns a list of /all/ entries in /dir/. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' The operand is not a valid directory name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The directory does not exist. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EACCES]@ * 'ResourceExhausted' Insufficient resources are available to perform the operation. @[EMFILE, ENFILE]@ * 'InappropriateType' The path refers to an existing non-directory object. @[ENOTDIR]@ -} getDirectoryContents :: FilePath -> IO [FilePath] getDirectoryContents path = modifyIOError ((`ioeSetFileName` path) . (`ioeSetLocation` "getDirectoryContents")) $ do bracket (Win32.findFirstFile (path "*")) (\(h,_) -> Win32.findClose h) (\(h,fdat) -> loop h fdat []) where -- we needn't worry about empty directories: adirectory always -- has at least "." and ".." entries loop :: Win32.HANDLE -> Win32.FindData -> [FilePath] -> IO [FilePath] loop h fdat acc = do filename <- Win32.getFindDataFileName fdat more <- Win32.findNextFile h fdat if more then loop h fdat (filename:acc) else return (filename:acc) -- no need to reverse, ordering is undefined {- |If the operating system has a notion of current directories, 'getCurrentDirectory' returns an absolute path to the current directory of the calling process. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'isDoesNotExistError' \/ 'NoSuchThing' There is no path referring to the current directory. @[EPERM, ENOENT, ESTALE...]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EACCES]@ * 'ResourceExhausted' Insufficient resources are available to perform the operation. * 'UnsupportedOperation' The operating system has no notion of current directory. -} getCurrentDirectory :: IO FilePath getCurrentDirectory = do Win32.getCurrentDirectory {- |If the operating system has a notion of current directories, @'setCurrentDirectory' dir@ changes the current directory of the calling process to /dir/. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' The operand is not a valid directory name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The directory does not exist. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EACCES]@ * 'UnsupportedOperation' The operating system has no notion of current directory, or the current directory cannot be dynamically changed. * 'InappropriateType' The path refers to an existing non-directory object. @[ENOTDIR]@ -} setCurrentDirectory :: FilePath -> IO () setCurrentDirectory path = Win32.setCurrentDirectory path {- |The operation 'doesDirectoryExist' returns 'True' if the argument file exists and is a directory, and 'False' otherwise. -} doesDirectoryExist :: FilePath -> IO Bool doesDirectoryExist name = (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st) `catch` ((\ _ -> return False) :: IOException -> IO Bool) {- |The operation 'doesFileExist' returns 'True' if the argument file exists and is not a directory, and 'False' otherwise. -} doesFileExist :: FilePath -> IO Bool doesFileExist name = (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b)) `catch` ((\ _ -> return False) :: IOException -> IO Bool) {- |The 'getModificationTime' operation returns the clock time at which the file or directory was last modified. The operation may fail with: * 'isPermissionError' if the user is not permitted to access the modification time; or * 'isDoesNotExistError' if the file or directory does not exist. -} getModificationTime :: FilePath -> IO ClockTime getModificationTime name = do -- ToDo: use Win32 API withFileStatus "getModificationTime" name $ \ st -> do modificationTime st withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a withFileStatus loc name f = do modifyIOError (`ioeSetFileName` name) $ allocaBytes sizeof_stat $ \p -> withFilePath (fileNameEndClean name) $ \s -> do throwErrnoIfMinus1Retry_ loc (c_stat s p) withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a withFileOrSymlinkStatus loc name f = do modifyIOError (`ioeSetFileName` name) $ allocaBytes sizeof_stat $ \p -> withFilePath name $ \s -> do throwErrnoIfMinus1Retry_ loc (lstat s p) modificationTime :: Ptr CStat -> IO ClockTime modificationTime stat = do mtime <- st_mtime stat let realToInteger = round . realToFrac :: Real a => a -> Integer return (TOD (realToInteger (mtime :: CTime)) 0) isDirectory :: Ptr CStat -> IO Bool isDirectory stat = do mode <- st_mode stat return (s_isdir mode) fileNameEndClean :: String -> String fileNameEndClean name = if isDrive name then addTrailingPathSeparator name else dropTrailingPathSeparator name foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode foreign import ccall unsafe "__hscore_long_path_size" long_path_size :: Int {- | Returns the current user's home directory. The directory returned is expected to be writable by the current user, but note that it isn't generally considered good practice to store application-specific data here; use 'getAppUserDataDirectory' instead. On Unix, 'getHomeDirectory' returns the value of the @HOME@ environment variable. On Windows, the system is queried for a suitable path; a typical path might be @C:/Documents And Settings/user@. The operation may fail with: * 'UnsupportedOperation' The operating system has no notion of home directory. * 'isDoesNotExistError' The home directory for the current user does not exist, or cannot be found. -} getHomeDirectory :: IO FilePath getHomeDirectory = modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do r <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PROFILE nullPtr 0 case (r :: Either IOException String) of Right s -> return s Left _ -> do r1 <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_WINDOWS nullPtr 0 case r1 of Right s -> return s Left e -> ioError (e :: IOException) {- | Returns the pathname of a directory in which application-specific data for the current user can be stored. The result of 'getAppUserDataDirectory' for a given application is specific to the current user. The argument should be the name of the application, which will be used to construct the pathname (so avoid using unusual characters that might result in an invalid pathname). Note: the directory may not actually exist, and may need to be created first. It is expected that the parent directory exists and is writable. On Unix, this function returns @$HOME\/.appName@. On Windows, a typical path might be > C:/Documents And Settings/user/Application Data/appName The operation may fail with: * 'UnsupportedOperation' The operating system has no notion of application-specific data directory. * 'isDoesNotExistError' The home directory for the current user does not exist, or cannot be found. -} getAppUserDataDirectory :: String -> IO FilePath getAppUserDataDirectory appName = do modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0 return (s++'\\':appName) {- | Returns the current user's document directory. The directory returned is expected to be writable by the current user, but note that it isn't generally considered good practice to store application-specific data here; use 'getAppUserDataDirectory' instead. On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@ environment variable. On Windows, the system is queried for a suitable path; a typical path might be @C:\/Documents and Settings\/user\/My Documents@. The operation may fail with: * 'UnsupportedOperation' The operating system has no notion of document directory. * 'isDoesNotExistError' The document directory for the current user does not exist, or cannot be found. -} getUserDocumentsDirectory :: IO FilePath getUserDocumentsDirectory = do modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0 {- | Returns the current directory for temporary files. On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@ environment variable or \"\/tmp\" if the variable isn\'t defined. On Windows, the function checks for the existence of environment variables in the following order and uses the first path found: * TMP environment variable. * TEMP environment variable. * USERPROFILE environment variable. * The Windows directory The operation may fail with: * 'UnsupportedOperation' The operating system has no notion of temporary directory. The function doesn\'t verify whether the path exists. -} getTemporaryDirectory :: IO FilePath getTemporaryDirectory = do Win32.getTemporaryDirectory -- ToDo: This should be determined via autoconf (AC_EXEEXT) -- | Extension for executable files -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2) exeExtension :: String exeExtension = "exe" haskell-src-exts-1.14.0/Test/examples/HappyDoAction.hs0000644000000000000000000000171012204617765020760 0ustar0000000000000000{-# LANGUAGE MagicHash #-} module HappyDoAction where foo :: Int# happyDoAction i tk st = {- nothing -} case action of 0# -> {- nothing -} happyFail i tk st -1# -> {- nothing -} happyAccept i tk st n | (n <# (0# :: Int#)) -> {- nothing -} (happyReduceArr ! rule) i tk st where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) n -> {- nothing -} happyShift new_state i tk st where new_state = (n -# (1# :: Int#)) where off = indexShortOffAddr happyActOffsets st off_i = (off +# i) check = if (off_i >=# (0# :: Int#)) then (indexShortOffAddr happyCheck off_i ==# i) else False action | check = indexShortOffAddr happyTable off_i | otherwise = indexShortOffAddr happyDefActions st haskell-src-exts-1.14.0/Test/examples/RelaxedDo.hs0000644000000000000000000000045012204617765020125 0ustar0000000000000000{-# LANGUAGE NondecreasingIndentation #-} module Main where import Control.Monad main :: IO () main = do when ( 2 > 1) $ do putStrLn "a" putStrLn "b" nestedDoBlocks = getChar >>= (\c1 -> do getChar >>= (\c2 -> do getChar >>= (\c3 -> return [c1,c2,c3])))haskell-src-exts-1.14.0/Test/examples/UnindentedPragmaClose.hs0000644000000000000000000000006512204617765022473 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} f :: Int f = 4haskell-src-exts-1.14.0/Test/examples/DoRec.hs0000644000000000000000000000010412204617765017246 0ustar0000000000000000{-# LANGUAGE DoRec #-} main = do rec let x = 1 return () haskell-src-exts-1.14.0/Test/examples/QuasiQuoteSplice.hs0000644000000000000000000000036012204617765021516 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, RankNTypes #-} {-# OPTIONS_GHC -F -pgmFtrhsx #-} import Language.Haskell.TH data PageFunction m a = PF main = let a = mkName "a" in runQ [t| forall m. PageFunction m $(conT (mkName "a")) |] >>= print haskell-src-exts-1.14.0/Test/examples/BangPatterns.hs0000644000000000000000000000044012204617765020645 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} module BangPatterns where firstnonspace :: Ptr Word8 -> Int -> Int -> IO Int firstnonspace !ptr !n !m | n >= m = return n | otherwise = do w <- peekElemOff ptr n if isSpaceWord8 w then firstnonspace ptr (n+1) m else return n haskell-src-exts-1.14.0/Test/examples/QualifiedDot.hs0000644000000000000000000000006012204617765020625 0ustar0000000000000000module QualifiedDot where twoDots = (Prelude..)haskell-src-exts-1.14.0/Test/examples/QuasiQuoteOld.hs0000644000000000000000000000020512204617765021013 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} import Here str :: String str = [$here|test test test test |] main :: IO() main = do putStrLn str haskell-src-exts-1.14.0/Test/examples/FamilyVarid.hs0000644000000000000000000000012312204617765020462 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module FamilyVarid where f family forall = undefinedhaskell-src-exts-1.14.0/Test/examples/HaskellParser.hs0000644000000000000000000000131512204617765021017 0ustar0000000000000000import qualified Language.Haskell.Exts.Annotated as Parser import qualified Language.Haskell.Exts.Annotated.Syntax as Syn import qualified Language.Haskell.Exts.Extension as Ext parse originalFileName input = Parser.parseModuleWithMode parseMode input where parseMode :: Parser.ParseMode parseMode = Parser.defaultParseMode { Parser.parseFilename = originalFileName , Parser.extensions = Ext.glasgowExts ++ [Ext.ExplicitForall] } main = do s <- readFile "Bug.hs" let x = parse "Bug.hs" s putStrLn (show x) haskell-src-exts-1.14.0/Test/examples/LineOptionsPragma.hs0000644000000000000000000000012112204617765021644 0ustar0000000000000000{-# OPTIONS #-} {-# LINE 49 "src/Language/C/Parser/Lexer.x" #-} module Fail wherehaskell-src-exts-1.14.0/Test/examples/GenericTree.hs0000644000000000000000000000030212204617765020446 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} module GenericTree where import Data.Typeable dynRep :: (Typeable a) => a -> (TypeRep, forall b. (Typeable b) => b -> (Maybe b)) dynRep a = (typeOf a, \_ -> cast a)haskell-src-exts-1.14.0/Test/examples/SpecializePhaseControl.hs0000644000000000000000000000064612204617765022677 0ustar0000000000000000{-# SPECIALISE [1] x :: Integer -> Integer -> Integer, Integer -> Int -> Integer, Int -> Int -> Int #-} {-# INLINABLE [1] x #-} x :: (Num a, Integral b) => a -> b -> a x = undefined {-# SPECIALISE INLINE [999] y :: Integer -> Integer -> Integer, Integer -> Int -> Integer, Int -> Int -> Int #-} {-# INLINABLE [1] y #-} y :: (Num a, Integral b) => a -> b -> a y = undefined haskell-src-exts-1.14.0/Test/examples/IfThenElseLayout.hs0000644000000000000000000000076212204617765021450 0ustar0000000000000000{-# LANGUAGE DoAndIfThenElse #-} module IfThenElseLayout where askCardsForExchange :: Hand -> IO [Card] askCardsForExchange h = do putStrLn "Wich card do you want to exchange? (Max. 3)" response <- getLine if length (readCards response) > 3 || not (all (flip elem h) h) then askCardsForExchange h else return (readCards response) haskell-src-exts-1.14.0/Test/examples/ForallInInstance.hs0000644000000000000000000000016612204617765021455 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module ForallInInstance where instance forall a. MyClass a => MyClass [a] where haskell-src-exts-1.14.0/Test/examples/FamilyKindSig.hs0000644000000000000000000000013712204617765020752 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module FamilyKindSig where type family WithKindSig (a :: * -> *)haskell-src-exts-1.14.0/Test/examples/NonDecreasing.hs0000644000000000000000000000025512204617765021000 0ustar0000000000000000module NonDecreasing where -- This should not work unless NondecreasingIndentation is -- on (which is is by default in GHC) main = do print 16 do print 17 print 18 haskell-src-exts-1.14.0/Test/examples/TypeOperatorAsVariable.hs0000644000000000000000000000010012204617765022635 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} type T (~>) = () type Foo = () haskell-src-exts-1.14.0/Test/examples/QuasiQuoteLines.hs0000644000000000000000000000020412204617765021346 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} import Here str :: String str = [here|test test test test |] main :: IO() main = do putStrLn str haskell-src-exts-1.14.0/Test/examples/WhereBlock.hs0000644000000000000000000000011312204617765020277 0ustar0000000000000000hash ptr len = f len where f h = return h f p = (p `advancePtr` 1) haskell-src-exts-1.14.0/Test/examples/GhcDeriving.hs0000644000000000000000000000014312204617765020446 0ustar0000000000000000 newtype CodeGenModule a = CGM (StateT CGMState IO a) deriving (Monad, MonadState [s], MonadIO)haskell-src-exts-1.14.0/Test/examples/DoubleHashOp.hs0000644000000000000000000000030712204617765020574 0ustar0000000000000000{-# LANGUAGE UnboxedTuples #-} module DoubleHashOp where (##) :: a -> b -> Int a ## b = 0 (#*) :: a -> b -> Int a #* b = 1 -- This still does not work though: -- (#) :: a -> b -> Int -- a # b = 2 haskell-src-exts-1.14.0/Test/examples/MultiCtxt.hs0000644000000000000000000000016212204617765020213 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} module MultiCtxt where multipleCtx :: Eq a => (Show a => a) multipleCtx = undefined haskell-src-exts-1.14.0/Test/examples/NestedAsPat.hs0000644000000000000000000000007612204617765020435 0ustar0000000000000000module NestedAsPat where nestedAsPat [x@(Just _)] = undefinedhaskell-src-exts-1.14.0/Test/examples/ForeignImport.hs0000644000000000000000000000035212204617765021043 0ustar0000000000000000{- If compiled without ForeignFunctionInterface (part of Haskell2010), it complains not about FFI but about missing TemplateHaskell -} foreign import ccall unsafe "getProgArgv" getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()haskell-src-exts-1.14.0/Test/examples/EmptyInstance.hs0000644000000000000000000000006012204617765021036 0ustar0000000000000000instance Traversable Tree where x :: Int x = 1 haskell-src-exts-1.14.0/Test/examples/Unicode.hs0000644000000000000000000000514412204617765017651 0ustar0000000000000000{-# LANGUAGE UnicodeSyntax #-} module Main where import System.Environment main :: IO () main = do as ↠getArgs print $ as print $ test 0 print $ test2 0 print $ testRewrite 0 print $ testRewriteReverse 0 print $ testRewrite2 0 print $ testRewriteReverse2 0 test :: a → Bool test x = pi where f = replicate 2000 x i = repeat x pf = f |> 300 pi = i |> 300 test2 :: a → (Bool,Bool) test2 x = (pf,pi) where f = replicate 2000 x i = repeat x pf = f |> 300 pi = i |> 300 testRewrite :: a → Bool testRewrite x = pi where f = replicate 2000 x i = repeat x lf = length f li = length i pf = lf > 300 pi = li > 300 testRewriteReverse :: a → Bool testRewriteReverse x = pi where f = replicate 2000 x i = repeat x lf = length f li = length i pf = 300 ≤ lf pi = 300 ≤ li testRewrite2 :: a → (Bool,Bool) testRewrite2 x = (length i > 300,300 > length i) where -- f = replicate 2000 x i = repeat x -- lf = length f -- li = length i -- pf = lf > 300 -- pi = li > 300 testRewriteReverse2 :: a → (Bool,Bool) testRewriteReverse2 x = (2000 < length i,length i > 20) where f = replicate 2000 x i = repeat x lf = length f li = length i pf = 2000 == lf pi = lf ≥ li lengthOP :: (Num a, Ord a) ⇒ Bool → (a → a → Bool) → [b] → a → Bool lengthOP v (⊜) [] n = 0 ⊜ n lengthOP v (⊜) xxs n = co xxs 0 where co (_:xs) c | n > c = co xs (c+1) | otherwise = v co [] c = c ⊜ n (≣) = (==) (≤) = (<=) (≥) = (>=) (|≣) = lengthOP False (≣) (|<) = lengthOP False (<) (|≤) = lengthOP False (≤) (|>) = lengthOP True (>) (|≥) = lengthOP True (≥) (|=) = lengthOP False (==) (|==) = lengthOP False (==) (|<=) = lengthOP False (<=) (|>=) = lengthOP False (>=) -- ≣≤≥ (≣|) = flip (|≣) (<|) = flip (|≥) (≤|) = flip (|>) (>|) = flip (|≤) (≥|) = flip (|<) {-# RULES -- length "xs |≣ n" forall xs n. (length xs) == n = xs |≣ n "xs |< n" forall xs n. (length xs) < n = xs |< n "xs |≤ n" forall xs n. (length xs) <= n = xs |≤ n "xs |> n" forall xs n. (length xs) > n = xs |> n "xs |≥ n" forall xs n. (length xs) >= n = xs |≥ n "n ≣| xs" forall xs n. n == (length xs) = xs |≣ n "n <| xs" forall xs n. n < (length xs) = xs |≥ n "n ≤| xs" forall xs n. n <= (length xs) = xs |> n "n >| xs" forall xs n. n > (length xs) = xs |≤ n "n ≥| xs" forall xs n. n >= (length xs) = xs |< n #-} haskell-src-exts-1.14.0/Test/examples/GadtDeriving.hs0000644000000000000000000000013412204617765020624 0ustar0000000000000000{-# LANGUAGE GADTs #-} data Foo where Foo :: Int -> Foo deriving (Eq,Ord,Typeable) haskell-src-exts-1.14.0/Test/examples/TupleSections.hs0000644000000000000000000000006112204617765021055 0ustar0000000000000000{-# LANGUAGE TupleSections #-} foo x = (1,,) x 3haskell-src-exts-1.14.0/Test/examples/CStyleLinePragmas.hs0000644000000000000000000000004412204617765021603 0ustar0000000000000000#line 1 "Main.hs" #line 2 "Main.hs" haskell-src-exts-1.14.0/Test/examples/ScopedTypeVariables.hs0000644000000000000000000000034012204617765022164 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} test :: IO Char test = do x :: Char <- getChar return x value :: String = "Hello" forallTest :: forall x . Eq x => x -> x forallTest x = if x == x then (undefined :: x) else xhaskell-src-exts-1.14.0/Test/examples/SCCPragmas.hs0000644000000000000000000000006312204617765020201 0ustar0000000000000000module SCCPragmas where x = {-# SCC "wibble" #-} 3haskell-src-exts-1.14.0/Test/examples/EmptyFunDepPremise.hs0000644000000000000000000000013112204617765021777 0ustar0000000000000000{-# LANGUAGE FunctionalDependencies #-} module EmptyFunDepPremise where class C a | -> ahaskell-src-exts-1.14.0/Test/examples/GADTRecord.hs0000644000000000000000000000010212204617765020126 0ustar0000000000000000{-# LANGUAGE GADTs #-} data T where T :: { field :: Int } -> T haskell-src-exts-1.14.0/Test/examples/ArityMismatch.hs0000644000000000000000000000010312204617765021027 0ustar0000000000000000module ArityMismatch where foo a b = 1 foo a = 2 bar = 1 baz = 2 haskell-src-exts-1.14.0/Test/examples/RealGHC.lhs0000644000000000000000000010243412204617765017644 0ustar0000000000000000% % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[CoreRules]{Transformation rules} \begin{code} {-# OPTIONS -w #-} {-# LANGUAGE PatternGuards #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details -- | Functions for collecting together and applying rewrite rules to a module. -- The 'CoreRule' datatype itself is declared elsewhere. module Rules ( -- * RuleBase RuleBase, -- ** Constructing emptyRuleBase, mkRuleBase, extendRuleBaseList, unionRuleBase, pprRuleBase, -- ** Checking rule applications ruleCheckProgram, -- ** Manipulating 'SpecInfo' rules mkSpecInfo, extendSpecInfo, addSpecInfo, addIdSpecialisations, -- * Misc. CoreRule helpers rulesOfBinds, getRules, pprRulesForUser, lookupRule, mkLocalRule, roughTopNames ) where -- #include "HsVersions.h" import CoreSyn -- All of it import OccurAnal ( occurAnalyseExpr ) import CoreFVs ( exprFreeVars, exprsFreeVars, bindFreeVars, rulesFreeVars ) import CoreUtils ( tcEqExprX, exprType ) import PprCore ( pprRules ) import Type ( Type, TvSubstEnv ) import Coercion ( coercionKind ) import TcType ( tcSplitTyConApp_maybe ) import CoreTidy ( tidyRules ) import Id import IdInfo ( SpecInfo( SpecInfo ) ) import Var ( Var ) import VarEnv import VarSet import Name ( Name, NamedThing(..) ) import NameEnv import Unify ( ruleMatchTyX, MatchEnv(..) ) import BasicTypes ( Activation ) import StaticFlags ( opt_PprStyle_Debug ) import Outputable import FastString import Maybes import OrdList import Bag import Util import Data.List \end{code} %************************************************************************ %* * \subsection[specialisation-IdInfo]{Specialisation info about an @Id@} %* * %************************************************************************ A @CoreRule@ holds details of one rule for an @Id@, which includes its specialisations. For example, if a rule for @f@ contains the mapping: \begin{verbatim} forall a b d. [Type (List a), Type b, Var d] ===> f' a b \end{verbatim} then when we find an application of f to matching types, we simply replace it by the matching RHS: \begin{verbatim} f (List Int) Bool dict ===> f' Int Bool \end{verbatim} All the stuff about how many dictionaries to discard, and what types to apply the specialised function to, are handled by the fact that the Rule contains a template for the result of the specialisation. There is one more exciting case, which is dealt with in exactly the same way. If the specialised value is unboxed then it is lifted at its definition site and unlifted at its uses. For example: pi :: forall a. Num a => a might have a specialisation [Int#] ===> (case pi' of Lift pi# -> pi#) where pi' :: Lift Int# is the specialised version of pi. \begin{code} mkLocalRule :: RuleName -> Activation -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'CoreSyn.CoreRule' mkLocalRule name act fn bndrs args rhs = Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs, ru_rough = roughTopNames args, ru_local = True } -------------- roughTopNames :: [CoreExpr] -> [Maybe Name] -- ^ Find the \"top\" free names of several expressions. -- Such names are either: -- -- 1. The function finally being applied to in an application chain -- (if that name is a GlobalId: see "Var#globalvslocal"), or -- -- 2. The 'TyCon' if the expression is a 'Type' -- -- This is used for the fast-match-check for rules; -- if the top names don't match, the rest can't roughTopNames args = map roughTopName args roughTopName :: CoreExpr -> Maybe Name roughTopName (Type ty) = case tcSplitTyConApp_maybe ty of Just (tc,_) -> Just (getName tc) Nothing -> Nothing roughTopName (App f a) = roughTopName f roughTopName (Var f) | isGlobalId f = Just (idName f) | otherwise = Nothing roughTopName other = Nothing ruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool -- ^ @ruleCantMatch tpl actual@ returns True only if @actual@ -- definitely can't match @tpl@ by instantiating @tpl@. -- It's only a one-way match; unlike instance matching we -- don't consider unification. -- -- Notice that [_$_] -- @ruleCantMatch [Nothing] [Just n2] = False@ -- Reason: a template variable can be instantiated by a constant -- Also: -- @ruleCantMatch [Just n1] [Nothing] = False@ -- Reason: a local variable @v@ in the actuals might [_$_] ruleCantMatch (Just n1 : ts) (Just n2 : as) = n1 /= n2 || ruleCantMatch ts as ruleCantMatch (t : ts) (a : as) = ruleCantMatch ts as ruleCantMatch ts as = False \end{code} \begin{code} pprRulesForUser :: [CoreRule] -> SDoc -- (a) tidy the rules -- (b) sort them into order based on the rule name -- (c) suppress uniques (unless -dppr-debug is on) -- This combination makes the output stable so we can use in testing -- It's here rather than in PprCore because it calls tidyRules pprRulesForUser rules = withPprStyle defaultUserStyle $ pprRules $ sortLe le_rule $ tidyRules emptyTidyEnv rules where le_rule r1 r2 = ru_name r1 <= ru_name r2 \end{code} %************************************************************************ %* * SpecInfo: the rules in an IdInfo %* * %************************************************************************ \begin{code} -- | Make a 'SpecInfo' containing a number of 'CoreRule's, suitable -- for putting into an 'IdInfo' mkSpecInfo :: [CoreRule] -> SpecInfo mkSpecInfo rules = SpecInfo rules (rulesFreeVars rules) extendSpecInfo :: SpecInfo -> [CoreRule] -> SpecInfo extendSpecInfo (SpecInfo rs1 fvs1) rs2 = SpecInfo (rs2 ++ rs1) (rulesFreeVars rs2 `unionVarSet` fvs1) addSpecInfo :: SpecInfo -> SpecInfo -> SpecInfo addSpecInfo (SpecInfo rs1 fvs1) (SpecInfo rs2 fvs2) = SpecInfo (rs1 ++ rs2) (fvs1 `unionVarSet` fvs2) addIdSpecialisations :: Id -> [CoreRule] -> Id addIdSpecialisations id [] = id addIdSpecialisations id rules = setIdSpecialisation id $ extendSpecInfo (idSpecialisation id) rules -- | Gather all the rules for locally bound identifiers from the supplied bindings rulesOfBinds :: [CoreBind] -> [CoreRule] rulesOfBinds binds = concatMap (concatMap idCoreRules . bindersOf) binds getRules :: RuleBase -> Id -> [CoreRule] -- The rules for an Id come from two places: -- (a) the ones it is born with (idCoreRules fn) -- (b) rules added in subsequent modules (extra_rules) -- PrimOps, for example, are born with a bunch of rules under (a) getRules rule_base fn | isLocalId fn = idCoreRules fn | otherwise = WARN( not (isPrimOpId fn) && notNull (idCoreRules fn), ppr fn <+> ppr (idCoreRules fn) ) idCoreRules fn ++ (lookupNameEnv rule_base (idName fn) `orElse` []) -- Only PrimOpIds have rules inside themselves, and perhaps more besides \end{code} %************************************************************************ %* * RuleBase %* * %************************************************************************ \begin{code} -- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules type RuleBase = NameEnv [CoreRule] -- The rules are are unordered; -- we sort out any overlaps on lookup emptyRuleBase = emptyNameEnv mkRuleBase :: [CoreRule] -> RuleBase mkRuleBase rules = extendRuleBaseList emptyRuleBase rules extendRuleBaseList :: RuleBase -> [CoreRule] -> RuleBase extendRuleBaseList rule_base new_guys = foldl extendRuleBase rule_base new_guys unionRuleBase :: RuleBase -> RuleBase -> RuleBase unionRuleBase rb1 rb2 = plusNameEnv_C (++) rb1 rb2 extendRuleBase :: RuleBase -> CoreRule -> RuleBase extendRuleBase rule_base rule = extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule pprRuleBase :: RuleBase -> SDoc pprRuleBase rules = vcat [ pprRules (tidyRules emptyTidyEnv rs) | rs <- nameEnvElts rules ] \end{code} %************************************************************************ %* * \subsection{Matching} %* * %************************************************************************ Note [Extra args in rule matching] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If we find a matching rule, we return (Just (rule, rhs)), but the rule firing has only consumed as many of the input args as the ruleArity says. It's up to the caller to keep track of any left-over args. E.g. if you call lookupRule ... f [e1, e2, e3] and it returns Just (r, rhs), where r has ruleArity 2 then the real rewrite is f e1 e2 e3 ==> rhs e3 You might think it'd be cleaner for lookupRule to deal with the leftover arguments, by applying 'rhs' to them, but the main call in the Simplifier works better as it is. Reason: the 'args' passed to lookupRule are the result of a lazy substitution \begin{code} -- | The main rule matching function. Attempts to apply all (active) -- supplied rules to this instance of an application in a given -- context, returning the rule applied and the resulting expression if -- successful. lookupRule :: (Activation -> Bool) -> InScopeSet -> Id -> [CoreExpr] -> [CoreRule] -> Maybe (CoreRule, CoreExpr) -- See Note [Extra args in rule matching] -- See comments on matchRule lookupRule is_active in_scope fn args rules = -- pprTrace "matchRules" (ppr fn <+> ppr rules) $ case go [] rules of [] -> Nothing (m:ms) -> Just (findBest (fn,args) m ms) where rough_args = map roughTopName args go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)] go ms [] = ms go ms (r:rs) = case (matchRule is_active in_scope args rough_args r) of Just e -> go ((r,e):ms) rs Nothing -> -- pprTrace "match failed" (ppr r $$ ppr args $$ -- ppr [(arg_id, unfoldingTemplate unf) | Var arg_id <- args, let unf = idUnfolding arg_id, isCheapUnfolding unf] ) go ms rs findBest :: (Id, [CoreExpr]) -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr) -- All these pairs matched the expression -- Return the pair the the most specific rule -- The (fn,args) is just for overlap reporting findBest target (rule,ans) [] = (rule,ans) findBest target (rule1,ans1) ((rule2,ans2):prs) | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs | debugIsOn = let pp_rule rule | opt_PprStyle_Debug = ppr rule | otherwise = doubleQuotes (ftext (ru_name rule)) in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)" (vcat [if opt_PprStyle_Debug then ptext (sLit "Expression to match:") <+> ppr fn <+> sep (map ppr args) else empty, ptext (sLit "Rule 1:") <+> pp_rule rule1, ptext (sLit "Rule 2:") <+> pp_rule rule2]) $ findBest target (rule1,ans1) prs | otherwise = findBest target (rule1,ans1) prs where (fn,args) = target isMoreSpecific :: CoreRule -> CoreRule -> Bool isMoreSpecific (BuiltinRule {}) r2 = True isMoreSpecific r1 (BuiltinRule {}) = False isMoreSpecific (Rule { ru_bndrs = bndrs1, ru_args = args1 }) (Rule { ru_bndrs = bndrs2, ru_args = args2 }) = isJust (matchN in_scope bndrs2 args2 args1) where in_scope = mkInScopeSet (mkVarSet bndrs1) -- Actually we should probably include the free vars -- of rule1's args, but I can't be bothered noBlackList :: Activation -> Bool noBlackList act = False -- Nothing is black listed matchRule :: (Activation -> Bool) -> InScopeSet -> [CoreExpr] -> [Maybe Name] -> CoreRule -> Maybe CoreExpr -- If (matchRule rule args) returns Just (name,rhs) -- then (f args) matches the rule, and the corresponding -- rewritten RHS is rhs -- -- The bndrs and rhs is occurrence-analysed -- -- Example -- -- The rule -- forall f g x. map f (map g x) ==> map (f . g) x -- is stored -- CoreRule "map/map" -- [f,g,x] -- tpl_vars -- [f,map g x] -- tpl_args -- map (f.g) x) -- rhs -- -- Then the call: matchRule the_rule [e1,map e2 e3] -- = Just ("map/map", (\f,g,x -> rhs) e1 e2 e3) -- -- Any 'surplus' arguments in the input are simply put on the end -- of the output. matchRule is_active in_scope args rough_args (BuiltinRule { ru_name = name, ru_try = match_fn }) = case match_fn args of Just expr -> Just expr Nothing -> Nothing matchRule is_active in_scope args rough_args (Rule { ru_name = rn, ru_act = act, ru_rough = tpl_tops, ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs }) | not (is_active act) = Nothing | ruleCantMatch tpl_tops rough_args = Nothing | otherwise = case matchN in_scope tpl_vars tpl_args args of Nothing -> Nothing Just (binds, tpl_vals) -> Just (mkLets binds $ rule_fn `mkApps` tpl_vals) where rule_fn = occurAnalyseExpr (mkLams tpl_vars rhs) -- We could do this when putting things into the rulebase, I guess \end{code} \begin{code} -- For a given match template and context, find bindings to wrap around -- the entire result and what should be substituted for each template variable. -- Fail if there are two few actual arguments from the target to match the template matchN :: InScopeSet -- ^ In-scope variables -> [Var] -- ^ Match template type variables -> [CoreExpr] -- ^ Match template -> [CoreExpr] -- ^ Target; can have more elements than the template -> Maybe ([CoreBind], [CoreExpr]) matchN in_scope tmpl_vars tmpl_es target_es = do { (tv_subst, id_subst, binds) <- go init_menv emptySubstEnv tmpl_es target_es ; return (fromOL binds, map (lookup_tmpl tv_subst id_subst) tmpl_vars') } where (init_rn_env, tmpl_vars') = mapAccumL rnBndrL (mkRnEnv2 in_scope) tmpl_vars -- See Note [Template binders] init_menv = ME { me_tmpls = mkVarSet tmpl_vars', me_env = init_rn_env } go menv subst [] es = Just subst go menv subst ts [] = Nothing -- Fail if too few actual args go menv subst (t:ts) (e:es) = do { subst1 <- match menv subst t e ; go menv subst1 ts es } lookup_tmpl :: TvSubstEnv -> IdSubstEnv -> Var -> CoreExpr lookup_tmpl tv_subst id_subst tmpl_var' | isTyVar tmpl_var' = case lookupVarEnv tv_subst tmpl_var' of Just ty -> Type ty Nothing -> unbound tmpl_var' | otherwise = case lookupVarEnv id_subst tmpl_var' of Just e -> e other -> unbound tmpl_var' unbound var = pprPanic "Template variable unbound in rewrite rule" (ppr var $$ ppr tmpl_vars $$ ppr tmpl_vars' $$ ppr tmpl_es $$ ppr target_es) \end{code} Note [Template binders] ~~~~~~~~~~~~~~~~~~~~~~~ Consider the following match: Template: forall x. f x Target: f (x+1) This should succeed, because the template variable 'x' has nothing to do with the 'x' in the target. On reflection, this case probably does just work, but this might not Template: forall x. f (\x.x) Target: f (\y.y) Here we want to clone when we find the \x, but to know that x must be in scope To achive this, we use rnBndrL to rename the template variables if necessary; the renamed ones are the tmpl_vars' --------------------------------------------- The inner workings of matching --------------------------------------------- \begin{code} -- These two definitions are not the same as in Subst, -- but they simple and direct, and purely local to this module -- -- * The domain of the TvSubstEnv and IdSubstEnv are the template -- variables passed into the match. -- -- * The (OrdList CoreBind) in a SubstEnv are the bindings floated out -- from nested matches; see the Let case of match, below -- type SubstEnv = (TvSubstEnv, IdSubstEnv, OrdList CoreBind) type IdSubstEnv = IdEnv CoreExpr emptySubstEnv :: SubstEnv emptySubstEnv = (emptyVarEnv, emptyVarEnv, nilOL) -- At one stage I tried to match even if there are more -- template args than real args. -- I now think this is probably a bad idea. -- Should the template (map f xs) match (map g)? I think not. -- For a start, in general eta expansion wastes work. -- SLPJ July 99 match :: MatchEnv -> SubstEnv -> CoreExpr -- Template -> CoreExpr -- Target -> Maybe SubstEnv -- See the notes with Unify.match, which matches types -- Everything is very similar for terms -- Interesting examples: -- Consider matching -- \x->f against \f->f -- When we meet the lambdas we must remember to rename f to f' in the -- second expresion. The RnEnv2 does that. -- -- Consider matching -- forall a. \b->b against \a->3 -- We must rename the \a. Otherwise when we meet the lambdas we -- might substitute [a/b] in the template, and then erroneously -- succeed in matching what looks like the template variable 'a' against 3. -- The Var case follows closely what happens in Unify.match match menv subst (Var v1) e2 | Just subst <- match_var menv subst v1 e2 = Just subst match menv subst e1 (Note n e2) = match menv subst e1 e2 -- Note [Notes in RULE matching] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Look through Notes. In particular, we don't want to -- be confused by InlineMe notes. Maybe we should be more -- careful about profiling notes, but for now I'm just -- riding roughshod over them. --- See Note [Notes in call patterns] in SpecConstr -- Here is another important rule: if the term being matched is a -- variable, we expand it so long as its unfolding is a WHNF -- (Its occurrence information is not necessarily up to date, -- so we don't use it.) match menv subst e1 (Var v2) | isCheapUnfolding unfolding = match menv subst e1 (unfoldingTemplate unfolding) where rn_env = me_env menv unfolding = idUnfolding (lookupRnInScope rn_env (rnOccR rn_env v2)) -- Notice that we look up v2 in the in-scope set -- See Note [Lookup in-scope] -- Remember to apply any renaming first (hence rnOccR) -- Note [Matching lets] -- ~~~~~~~~~~~~~~~~~~~~ -- Matching a let-expression. Consider -- RULE forall x. f (g x) = -- and target expression -- f (let { w=R } in g E)) -- Then we'd like the rule to match, to generate -- let { w=R } in (\x. ) E -- In effect, we want to float the let-binding outward, to enable -- the match to happen. This is the WHOLE REASON for accumulating -- bindings in the SubstEnv -- -- We can only do this if -- (a) Widening the scope of w does not capture any variables -- We use a conservative test: w is not already in scope -- If not, we clone the binders, and substitute -- (b) The free variables of R are not bound by the part of the -- target expression outside the let binding; e.g. -- f (\v. let w = v+1 in g E) -- Here we obviously cannot float the let-binding for w. -- -- You may think rule (a) would never apply, because rule matching is -- mostly invoked from the simplifier, when we have just run substExpr -- over the argument, so there will be no shadowing anyway. -- The fly in the ointment is that the forall'd variables of the -- RULE itself are considered in scope. -- -- I though of various cheapo ways to solve this tiresome problem, -- but ended up doing the straightforward thing, which is to -- clone the binders if they are in scope. It's tiresome, and -- potentially inefficient, because of the calls to substExpr, -- but I don't think it'll happen much in pracice. {- Cases to think about (let x=y+1 in \x. (x,x)) --> let x=y+1 in (\x1. (x1,x1)) (\x. let x = y+1 in (x,x)) --> let x1 = y+1 in (\x. (x1,x1) (let x=y+1 in (x,x), let x=y-1 in (x,x)) --> let x=y+1 in let x1=y-1 in ((x,x),(x1,x1)) Watch out! (let x=y+1 in let z=x+1 in (z,z) --> matches (p,p) but watch out that the use of x on z's rhs is OK! I'm removing the cloning because that makes the above case fail, because the inner let looks as if it has locally-bound vars -} match menv subst@(tv_subst, id_subst, binds) e1 (Let bind e2) | all freshly_bound bndrs, not (any locally_bound bind_fvs) = match (menv { me_env = rn_env' }) (tv_subst, id_subst, binds `snocOL` bind') e1 e2' where rn_env = me_env menv bndrs = bindersOf bind bind_fvs = varSetElems (bindFreeVars bind) locally_bound x = inRnEnvR rn_env x freshly_bound x = not (x `rnInScope` rn_env) bind' = bind e2' = e2 rn_env' = extendRnInScopeList rn_env bndrs {- (rn_env', bndrs') = mapAccumL rnBndrR rn_env bndrs s_prs = [(bndr, Var bndr') | (bndr,bndr') <- zip bndrs bndrs', bndr /= bndr'] subst = mkSubst (rnInScopeSet rn_env) emptyVarEnv (mkVarEnv s_prs) (bind', e2') | null s_prs = (bind, e2) | otherwise = (s_bind, substExpr subst e2) s_bind = case bind of NonRec {} -> NonRec (head bndrs') (head rhss) Rec {} -> Rec (bndrs' `zip` map (substExpr subst) rhss) -} match menv subst (Lit lit1) (Lit lit2) | lit1 == lit2 = Just subst match menv subst (App f1 a1) (App f2 a2) = do { subst' <- match menv subst f1 f2 ; match menv subst' a1 a2 } match menv subst (Lam x1 e1) (Lam x2 e2) = match menv' subst e1 e2 where menv' = menv { me_env = rnBndr2 (me_env menv) x1 x2 } -- This rule does eta expansion -- (\x.M) ~ N iff M ~ N x -- It's important that this is *after* the let rule, -- so that (\x.M) ~ (let y = e in \y.N) -- does the let thing, and then gets the lam/lam rule above match menv subst (Lam x1 e1) e2 = match menv' subst e1 (App e2 (varToCoreExpr new_x)) where (rn_env', new_x) = rnBndrL (me_env menv) x1 menv' = menv { me_env = rn_env' } -- Eta expansion the other way -- M ~ (\y.N) iff M y ~ N match menv subst e1 (Lam x2 e2) = match menv' subst (App e1 (varToCoreExpr new_x)) e2 where (rn_env', new_x) = rnBndrR (me_env menv) x2 menv' = menv { me_env = rn_env' } match menv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2) = do { subst1 <- match_ty menv subst ty1 ty2 ; subst2 <- match menv subst1 e1 e2 ; let menv' = menv { me_env = rnBndr2 (me_env menv) x1 x2 } ; match_alts menv' subst2 alts1 alts2 -- Alts are both sorted } match menv subst (Type ty1) (Type ty2) = match_ty menv subst ty1 ty2 match menv subst (Cast e1 co1) (Cast e2 co2) = do { subst1 <- match_ty menv subst co1 co2 ; match menv subst1 e1 e2 } {- REMOVING OLD CODE: I think that the above handling for let is better than the stuff here, which looks pretty suspicious to me. SLPJ Sept 06 -- This is an interesting rule: we simply ignore lets in the -- term being matched against! The unfolding inside it is (by assumption) -- already inside any occurrences of the bound variables, so we'll expand -- them when we encounter them. This gives a chance of matching -- forall x,y. f (g (x,y)) -- against -- f (let v = (a,b) in g v) match menv subst e1 (Let bind e2) = match (menv { me_env = rn_env' }) subst e1 e2 where (rn_env', _bndrs') = mapAccumL rnBndrR (me_env menv) (bindersOf bind) -- It's important to do this renaming, so that the bndrs -- are brought into the local scope. For example: -- Matching -- forall f,x,xs. f (x:xs) -- against -- f (let y = e in (y:[])) -- We must not get success with x->y! So we record that y is -- locally bound (with rnBndrR), and proceed. The Var case -- will fail when trying to bind x->y -} -- Everything else fails match menv subst e1 e2 = -- pprTrace "Failing at" ((text "e1:" <+> ppr e1) $$ (text "e2:" <+> ppr e2)) $ Nothing ------------------------------------------ match_var :: MatchEnv -> SubstEnv -> Var -- Template -> CoreExpr -- Target -> Maybe SubstEnv match_var menv subst@(tv_subst, id_subst, binds) v1 e2 | v1' `elemVarSet` me_tmpls menv = case lookupVarEnv id_subst v1' of Nothing | any (inRnEnvR rn_env) (varSetElems (exprFreeVars e2)) -> Nothing -- Occurs check failure -- e.g. match forall a. (\x-> a x) against (\y. y y) | otherwise -- No renaming to do on e2, because no free var -- of e2 is in the rnEnvR of the envt -- Note [Matching variable types] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- However, we must match the *types*; e.g. -- forall (c::Char->Int) (x::Char). -- f (c x) = "RULE FIRED" -- We must only match on args that have the right type -- It's actually quite difficult to come up with an example that shows -- you need type matching, esp since matching is left-to-right, so type -- args get matched first. But it's possible (e.g. simplrun008) and -- this is the Right Thing to do -> do { tv_subst' <- Unify.ruleMatchTyX menv tv_subst (idType v1') (exprType e2) -- c.f. match_ty below ; return (tv_subst', extendVarEnv id_subst v1' e2, binds) } Just e1' | tcEqExprX (nukeRnEnvL rn_env) e1' e2 -> Just subst | otherwise -> Nothing | otherwise -- v1 is not a template variable; check for an exact match with e2 = case e2 of Var v2 | v1' == rnOccR rn_env v2 -> Just subst other -> Nothing where rn_env = me_env menv v1' = rnOccL rn_env v1 -- If the template is -- forall x. f x (\x -> x) = ... -- Then the x inside the lambda isn't the -- template x, so we must rename first! ------------------------------------------ match_alts :: MatchEnv -> SubstEnv -> [CoreAlt] -- Template -> [CoreAlt] -- Target -> Maybe SubstEnv match_alts menv subst [] [] = return subst match_alts menv subst ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2) | c1 == c2 = do { subst1 <- match menv' subst r1 r2 ; match_alts menv subst1 alts1 alts2 } where menv' :: MatchEnv menv' = menv { me_env = rnBndrs2 (me_env menv) vs1 vs2 } match_alts menv subst alts1 alts2 = Nothing \end{code} Matching Core types: use the matcher in TcType. Notice that we treat newtypes as opaque. For example, suppose we have a specialised version of a function at a newtype, say newtype T = MkT Int We only want to replace (f T) with f', not (f Int). \begin{code} ------------------------------------------ match_ty :: MatchEnv -> SubstEnv -> Type -- Template -> Type -- Target -> Maybe SubstEnv match_ty menv (tv_subst, id_subst, binds) ty1 ty2 = do { tv_subst' <- Unify.ruleMatchTyX menv tv_subst ty1 ty2 ; return (tv_subst', id_subst, binds) } \end{code} Note [Lookup in-scope] ~~~~~~~~~~~~~~~~~~~~~~ Consider this example foo :: Int -> Maybe Int -> Int foo 0 (Just n) = n foo m (Just n) = foo (m-n) (Just n) SpecConstr sees this fragment: case w_smT of wild_Xf [Just A] { Data.Maybe.Nothing -> lvl_smf; Data.Maybe.Just n_acT [Just S(L)] -> case n_acT of wild1_ams [Just A] { GHC.Base.I# y_amr [Just L] -> \$wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf }}; and correctly generates the rule RULES: "SC:$wfoo1" [0] __forall {y_amr [Just L] :: GHC.Prim.Int# sc_snn :: GHC.Prim.Int#} \$wfoo_smW sc_snn (Data.Maybe.Just @ GHC.Base.Int (GHC.Base.I# y_amr)) = \$s\$wfoo_sno y_amr sc_snn ;] BUT we must ensure that this rule matches in the original function! Note that the call to \$wfoo is \$wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf During matching we expand wild_Xf to (Just n_acT). But then we must also expand n_acT to (I# y_amr). And we can only do that if we look up n_acT in the in-scope set, because in wild_Xf's unfolding it won't have an unfolding at all. That is why the 'lookupRnInScope' call in the (Var v2) case of 'match' is so important. %************************************************************************ %* * \subsection{Checking a program for failing rule applications} %* * %************************************************************************ ----------------------------------------------------- Game plan ----------------------------------------------------- We want to know what sites have rules that could have fired but didn't. This pass runs over the tree (without changing it) and reports such. \begin{code} -- | Report partial matches for rules beginning with the specified -- string for the purposes of error reporting ruleCheckProgram :: (Activation -> Bool) -- ^ Rule activation test -> String -- ^ Rule pattern -> RuleBase -- ^ Database of rules -> [CoreBind] -- ^ Bindings to check in -> SDoc -- ^ Resulting check message ruleCheckProgram is_active rule_pat rule_base binds | isEmptyBag results = text "Rule check results: no rule application sites" | otherwise = vcat [text "Rule check results:", line, vcat [ p $$ line | p <- bagToList results ] ] where results = unionManyBags (map (ruleCheckBind (RuleCheckEnv is_active rule_pat rule_base)) binds) line = text (replicate 20 '-') data RuleCheckEnv = RuleCheckEnv { rc_is_active :: Activation -> Bool, rc_pattern :: String, rc_rule_base :: RuleBase } ruleCheckBind :: RuleCheckEnv -> CoreBind -> Bag SDoc -- The Bag returned has one SDoc for each call site found ruleCheckBind env (NonRec b r) = ruleCheck env r ruleCheckBind env (Rec prs) = unionManyBags [ruleCheck env r | (b,r) <- prs] ruleCheck :: RuleCheckEnv -> CoreExpr -> Bag SDoc ruleCheck env (Var v) = emptyBag ruleCheck env (Lit l) = emptyBag ruleCheck env (Type ty) = emptyBag ruleCheck env (App f a) = ruleCheckApp env (App f a) [] ruleCheck env (Note n e) = ruleCheck env e ruleCheck env (Cast e co) = ruleCheck env e ruleCheck env (Let bd e) = ruleCheckBind env bd `unionBags` ruleCheck env e ruleCheck env (Lam b e) = ruleCheck env e ruleCheck env (Case e _ _ as) = ruleCheck env e `unionBags` unionManyBags [ruleCheck env r | (_,_,r) <- as] ruleCheckApp env (App f a) as = ruleCheck env a `unionBags` ruleCheckApp env f (a:as) ruleCheckApp env (Var f) as = ruleCheckFun env f as ruleCheckApp env other as = ruleCheck env other \end{code} \begin{code} ruleCheckFun :: RuleCheckEnv -> Id -> [CoreExpr] -> Bag SDoc -- Produce a report for all rules matching the predicate -- saying why it doesn't match the specified application ruleCheckFun env fn args | null name_match_rules = emptyBag | otherwise = unitBag (ruleAppCheck_help (rc_is_active env) fn args name_match_rules) where name_match_rules = filter match (getRules (rc_rule_base env) fn) match rule = (rc_pattern env) `isPrefixOf` unpackFS (ruleName rule) ruleAppCheck_help :: (Activation -> Bool) -> Id -> [CoreExpr] -> [CoreRule] -> SDoc ruleAppCheck_help is_active fn args rules = -- The rules match the pattern, so we want to print something vcat [text "Expression:" <+> ppr (mkApps (Var fn) args), vcat (map check_rule rules)] where n_args = length args i_args = args `zip` [1::Int ..] rough_args = map roughTopName args check_rule rule = rule_herald rule <> colon <+> rule_info rule rule_herald (BuiltinRule { ru_name = name }) = ptext (sLit "Builtin rule") <+> doubleQuotes (ftext name) rule_herald (Rule { ru_name = name }) = ptext (sLit "Rule") <+> doubleQuotes (ftext name) rule_info rule | Just _ <- matchRule noBlackList emptyInScopeSet args rough_args rule = text "matches (which is very peculiar!)" rule_info (BuiltinRule {}) = text "does not match" rule_info (Rule { ru_name = name, ru_act = act, ru_bndrs = rule_bndrs, ru_args = rule_args}) | not (is_active act) = text "active only in later phase" | n_args < n_rule_args = text "too few arguments" | n_mismatches == n_rule_args = text "no arguments match" | n_mismatches == 0 = text "all arguments match (considered individually), but rule as a whole does not" | otherwise = text "arguments" <+> ppr mismatches <+> text "do not match (1-indexing)" where n_rule_args = length rule_args n_mismatches = length mismatches mismatches = [i | (rule_arg, (arg,i)) <- rule_args `zip` i_args, not (isJust (match_fn rule_arg arg))] lhs_fvs = exprsFreeVars rule_args -- Includes template tyvars match_fn rule_arg arg = match menv emptySubstEnv rule_arg arg where in_scope = lhs_fvs `unionVarSet` exprFreeVars arg menv = ME { me_env = mkRnEnv2 (mkInScopeSet in_scope) , me_tmpls = mkVarSet rule_bndrs } \end{code} haskell-src-exts-1.14.0/Test/examples/MultiWayIf.hs0000644000000000000000000000020712204617765020310 0ustar0000000000000000{-# LANGUAGE MultiWayIf #-} module MultiWayIf where foo = if | test1 -> e1 | test2 witharg -> e2 | otherwise -> def haskell-src-exts-1.14.0/Test/examples/UnicodeSyntax.hs0000644000000000000000000000036712204617765021062 0ustar0000000000000000{-# LANGUAGE UnicodeSyntax, ExplicitForall #-} module UnicodeSyntax where import System.Environment (getArgs) main :: IO () main = do as ↠getArgs print $ test 0 test :: Int → Bool test x = x*5 == x+8 id1 ∷ ∀ a . a → a id1 x = x haskell-src-exts-1.14.0/dist/0000755000000000000000000000000012204617765014131 5ustar0000000000000000haskell-src-exts-1.14.0/dist/build/0000755000000000000000000000000012204617765015230 5ustar0000000000000000haskell-src-exts-1.14.0/dist/build/Language/0000755000000000000000000000000012204617765016753 5ustar0000000000000000haskell-src-exts-1.14.0/dist/build/Language/Haskell/0000755000000000000000000000000012204617765020336 5ustar0000000000000000haskell-src-exts-1.14.0/dist/build/Language/Haskell/Exts/0000755000000000000000000000000012204617771021256 5ustar0000000000000000haskell-src-exts-1.14.0/dist/build/Language/Haskell/Exts/InternalParser.hs0000644000000000000000000202745512204617771024562 0ustar0000000000000000{-# OPTIONS_GHC -w #-} {-# OPTIONS -fglasgow-exts -cpp #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Annotated.Parser -- Copyright : (c) Niklas Broberg 2004-2009, -- Original (c) Simon Marlow, Sven Panne 1997-2000 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.InternalParser ( -- * General parsing ParseMode(..), defaultParseMode, ParseResult(..), fromParseResult, -- * Parsing of specific AST elements -- ** Modules parseModule, parseModuleWithMode, parseModuleWithComments, -- ** Expressions parseExp, parseExpWithMode, parseExpWithComments, -- ** Statements parseStmt, parseStmtWithMode, parseStmtWithComments, -- ** Patterns parsePat, parsePatWithMode, parsePatWithComments, -- ** Declarations parseDecl, parseDeclWithMode, parseDeclWithComments, -- ** Types parseType, parseTypeWithMode, parseTypeWithComments, -- ** Multiple modules in one file parseModules, parseModulesWithMode, parseModulesWithComments, -- ** Option pragmas getTopPragmas ) where import Language.Haskell.Exts.Annotated.Syntax hiding ( Type(..), Exp(..), Asst(..), XAttr(..), FieldUpdate(..) ) import Language.Haskell.Exts.Annotated.Syntax ( Type, Exp, Asst ) import Language.Haskell.Exts.ParseMonad import Language.Haskell.Exts.InternalLexer import Language.Haskell.Exts.ParseUtils import Language.Haskell.Exts.Annotated.Fixity import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.Comments ( Comment ) import Language.Haskell.Exts.Extension import Control.Monad ( liftM, (<=<) ) import qualified Data.Array as Happy_Data_Array import qualified GHC.Exts as Happy_GHC_Exts -- parser produced by Happy Version 1.18.10 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 type HappyAny = Happy_GHC_Exts.Any #else type HappyAny = forall a . a #endif happyIn11 :: ([Module L]) -> (HappyAbsSyn ) happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn11 #-} happyOut11 :: (HappyAbsSyn ) -> ([Module L]) happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut11 #-} happyIn12 :: ([[ModulePragma L] -> [S] -> L -> Module L]) -> (HappyAbsSyn ) happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn12 #-} happyOut12 :: (HappyAbsSyn ) -> ([[ModulePragma L] -> [S] -> L -> Module L]) happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut12 #-} happyIn13 :: (Module L) -> (HappyAbsSyn ) happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn13 #-} happyOut13 :: (HappyAbsSyn ) -> (Module L) happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut13 #-} happyIn14 :: (PExp L) -> (HappyAbsSyn ) happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn14 #-} happyOut14 :: (HappyAbsSyn ) -> (PExp L) happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut14 #-} happyIn15 :: (([ModulePragma L],[S],L)) -> (HappyAbsSyn ) happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn15 #-} happyOut15 :: (HappyAbsSyn ) -> (([ModulePragma L],[S],L)) happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut15 #-} happyIn16 :: (([ModulePragma L],[S],Maybe L)) -> (HappyAbsSyn ) happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn16 #-} happyOut16 :: (HappyAbsSyn ) -> (([ModulePragma L],[S],Maybe L)) happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut16 #-} happyIn17 :: (ModulePragma L) -> (HappyAbsSyn ) happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn17 #-} happyOut17 :: (HappyAbsSyn ) -> (ModulePragma L) happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut17 #-} happyIn18 :: (([Name L],[S])) -> (HappyAbsSyn ) happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn18 #-} happyOut18 :: (HappyAbsSyn ) -> (([Name L],[S])) happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut18 #-} happyIn19 :: ([ModulePragma L] -> [S] -> L -> Module L) -> (HappyAbsSyn ) happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn19 #-} happyOut19 :: (HappyAbsSyn ) -> ([ModulePragma L] -> [S] -> L -> Module L) happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut19 #-} happyIn20 :: (Maybe (ModuleHead L)) -> (HappyAbsSyn ) happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn20 #-} happyOut20 :: (HappyAbsSyn ) -> (Maybe (ModuleHead L)) happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut20 #-} happyIn21 :: (Maybe (WarningText L)) -> (HappyAbsSyn ) happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn21 #-} happyOut21 :: (HappyAbsSyn ) -> (Maybe (WarningText L)) happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut21 #-} happyIn22 :: (([ImportDecl L],[Decl L],[S],L)) -> (HappyAbsSyn ) happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn22 #-} happyOut22 :: (HappyAbsSyn ) -> (([ImportDecl L],[Decl L],[S],L)) happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut22 #-} happyIn23 :: (([ImportDecl L],[Decl L],[S])) -> (HappyAbsSyn ) happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn23 #-} happyOut23 :: (HappyAbsSyn ) -> (([ImportDecl L],[Decl L],[S])) happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut23 #-} happyIn24 :: ([S]) -> (HappyAbsSyn ) happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn24 #-} happyOut24 :: (HappyAbsSyn ) -> ([S]) happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut24 #-} happyIn25 :: ([S]) -> (HappyAbsSyn ) happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn25 #-} happyOut25 :: (HappyAbsSyn ) -> ([S]) happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut25 #-} happyIn26 :: (Maybe (ExportSpecList L)) -> (HappyAbsSyn ) happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn26 #-} happyOut26 :: (HappyAbsSyn ) -> (Maybe (ExportSpecList L)) happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut26 #-} happyIn27 :: (ExportSpecList L) -> (HappyAbsSyn ) happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn27 #-} happyOut27 :: (HappyAbsSyn ) -> (ExportSpecList L) happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut27 #-} happyIn28 :: ([S]) -> (HappyAbsSyn ) happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn28 #-} happyOut28 :: (HappyAbsSyn ) -> ([S]) happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut28 #-} happyIn29 :: (([ExportSpec L],[S])) -> (HappyAbsSyn ) happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn29 #-} happyOut29 :: (HappyAbsSyn ) -> (([ExportSpec L],[S])) happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut29 #-} happyIn30 :: (ExportSpec L) -> (HappyAbsSyn ) happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn30 #-} happyOut30 :: (HappyAbsSyn ) -> (ExportSpec L) happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut30 #-} happyIn31 :: (([ImportDecl L],[S])) -> (HappyAbsSyn ) happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn31 #-} happyOut31 :: (HappyAbsSyn ) -> (([ImportDecl L],[S])) happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut31 #-} happyIn32 :: (ImportDecl L) -> (HappyAbsSyn ) happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn32 #-} happyOut32 :: (HappyAbsSyn ) -> (ImportDecl L) happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut32 #-} happyIn33 :: ((Bool,[S])) -> (HappyAbsSyn ) happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn33 #-} happyOut33 :: (HappyAbsSyn ) -> ((Bool,[S])) happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut33 #-} happyIn34 :: ((Bool,[S])) -> (HappyAbsSyn ) happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn34 #-} happyOut34 :: (HappyAbsSyn ) -> ((Bool,[S])) happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut34 #-} happyIn35 :: ((Maybe String,[S])) -> (HappyAbsSyn ) happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn35 #-} happyOut35 :: (HappyAbsSyn ) -> ((Maybe String,[S])) happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut35 #-} happyIn36 :: ((Maybe (ModuleName L),[S],Maybe L)) -> (HappyAbsSyn ) happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn36 #-} happyOut36 :: (HappyAbsSyn ) -> ((Maybe (ModuleName L),[S],Maybe L)) happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut36 #-} happyIn37 :: (Maybe (ImportSpecList L)) -> (HappyAbsSyn ) happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn37 #-} happyOut37 :: (HappyAbsSyn ) -> (Maybe (ImportSpecList L)) happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut37 #-} happyIn38 :: (ImportSpecList L) -> (HappyAbsSyn ) happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn38 #-} happyOut38 :: (HappyAbsSyn ) -> (ImportSpecList L) happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut38 #-} happyIn39 :: ((Bool, Maybe L,[S])) -> (HappyAbsSyn ) happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn39 #-} happyOut39 :: (HappyAbsSyn ) -> ((Bool, Maybe L,[S])) happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut39 #-} happyIn40 :: (([ImportSpec L],[S])) -> (HappyAbsSyn ) happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn40 #-} happyOut40 :: (HappyAbsSyn ) -> (([ImportSpec L],[S])) happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut40 #-} happyIn41 :: (ImportSpec L) -> (HappyAbsSyn ) happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn41 #-} happyOut41 :: (HappyAbsSyn ) -> (ImportSpec L) happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut41 #-} happyIn42 :: (([CName L],[S])) -> (HappyAbsSyn ) happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn42 #-} happyOut42 :: (HappyAbsSyn ) -> (([CName L],[S])) happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut42 #-} happyIn43 :: (CName L) -> (HappyAbsSyn ) happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn43 #-} happyOut43 :: (HappyAbsSyn ) -> (CName L) happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut43 #-} happyIn44 :: (Decl L) -> (HappyAbsSyn ) happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn44 #-} happyOut44 :: (HappyAbsSyn ) -> (Decl L) happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut44 #-} happyIn45 :: ((Maybe Int, [S])) -> (HappyAbsSyn ) happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn45 #-} happyOut45 :: (HappyAbsSyn ) -> ((Maybe Int, [S])) happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut45 #-} happyIn46 :: (Assoc L) -> (HappyAbsSyn ) happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn46 #-} happyOut46 :: (HappyAbsSyn ) -> (Assoc L) happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut46 #-} happyIn47 :: (([Op L],[S],L)) -> (HappyAbsSyn ) happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn47 #-} happyOut47 :: (HappyAbsSyn ) -> (([Op L],[S],L)) happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut47 #-} happyIn48 :: (([Decl L],[S])) -> (HappyAbsSyn ) happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn48 #-} happyOut48 :: (HappyAbsSyn ) -> (([Decl L],[S])) happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut48 #-} happyIn49 :: (([Decl L],[S])) -> (HappyAbsSyn ) happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn49 #-} happyOut49 :: (HappyAbsSyn ) -> (([Decl L],[S])) happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut49 #-} happyIn50 :: (Decl L) -> (HappyAbsSyn ) happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn50 #-} happyOut50 :: (HappyAbsSyn ) -> (Decl L) happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut50 #-} happyIn51 :: (DataOrNew L) -> (HappyAbsSyn ) happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn51 #-} happyOut51 :: (HappyAbsSyn ) -> (DataOrNew L) happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut51 #-} happyIn52 :: (([Type L],[S])) -> (HappyAbsSyn ) happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn52 #-} happyOut52 :: (HappyAbsSyn ) -> (([Type L],[S])) happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut52 #-} happyIn53 :: (([Decl L],[S])) -> (HappyAbsSyn ) happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn53 #-} happyOut53 :: (HappyAbsSyn ) -> (([Decl L],[S])) happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut53 #-} happyIn54 :: (([Decl L],[S])) -> (HappyAbsSyn ) happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn54 #-} happyOut54 :: (HappyAbsSyn ) -> (([Decl L],[S])) happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut54 #-} happyIn55 :: (Decl L) -> (HappyAbsSyn ) happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn55 #-} happyOut55 :: (HappyAbsSyn ) -> (Decl L) happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut55 #-} happyIn56 :: (Binds L) -> (HappyAbsSyn ) happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn56 #-} happyOut56 :: (HappyAbsSyn ) -> (Binds L) happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut56 #-} happyIn57 :: (Decl L) -> (HappyAbsSyn ) happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn57 #-} happyOut57 :: (HappyAbsSyn ) -> (Decl L) happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut57 #-} happyIn58 :: (Decl L) -> (HappyAbsSyn ) happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn58 #-} happyOut58 :: (HappyAbsSyn ) -> (Decl L) happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut58 #-} happyIn59 :: (([Type L],[S])) -> (HappyAbsSyn ) happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn59 #-} happyOut59 :: (HappyAbsSyn ) -> (([Type L],[S])) happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut59 #-} happyIn60 :: (Type L) -> (HappyAbsSyn ) happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn60 #-} happyOut60 :: (HappyAbsSyn ) -> (Type L) happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut60 #-} happyIn61 :: (Binds L) -> (HappyAbsSyn ) happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn61 #-} happyOut61 :: (HappyAbsSyn ) -> (Binds L) happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut61 #-} happyIn62 :: (([Name L],[S],L)) -> (HappyAbsSyn ) happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn62 #-} happyOut62 :: (HappyAbsSyn ) -> (([Name L],[S],L)) happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut62 #-} happyIn63 :: (CallConv L) -> (HappyAbsSyn ) happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn63 #-} happyOut63 :: (HappyAbsSyn ) -> (CallConv L) happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut63 #-} happyIn64 :: (Maybe (Safety L)) -> (HappyAbsSyn ) happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn64 #-} happyOut64 :: (HappyAbsSyn ) -> (Maybe (Safety L)) happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut64 #-} happyIn65 :: ((Maybe String, Name L, Type L, [S])) -> (HappyAbsSyn ) happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn65 #-} happyOut65 :: (HappyAbsSyn ) -> ((Maybe String, Name L, Type L, [S])) happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut65 #-} happyIn66 :: ([Rule L]) -> (HappyAbsSyn ) happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn66 #-} happyOut66 :: (HappyAbsSyn ) -> ([Rule L]) happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut66 #-} happyIn67 :: (Rule L) -> (HappyAbsSyn ) happyIn67 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn67 #-} happyOut67 :: (HappyAbsSyn ) -> (Rule L) happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut67 #-} happyIn68 :: (Maybe (Activation L)) -> (HappyAbsSyn ) happyIn68 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn68 #-} happyOut68 :: (HappyAbsSyn ) -> (Maybe (Activation L)) happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut68 #-} happyIn69 :: ((Maybe [RuleVar L],[S])) -> (HappyAbsSyn ) happyIn69 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn69 #-} happyOut69 :: (HappyAbsSyn ) -> ((Maybe [RuleVar L],[S])) happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut69 #-} happyIn70 :: ([RuleVar L]) -> (HappyAbsSyn ) happyIn70 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn70 #-} happyOut70 :: (HappyAbsSyn ) -> ([RuleVar L]) happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut70 #-} happyIn71 :: (RuleVar L) -> (HappyAbsSyn ) happyIn71 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn71 #-} happyOut71 :: (HappyAbsSyn ) -> (RuleVar L) happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut71 #-} happyIn72 :: (([([Name L],String)],[S])) -> (HappyAbsSyn ) happyIn72 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn72 #-} happyOut72 :: (HappyAbsSyn ) -> (([([Name L],String)],[S])) happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut72 #-} happyIn73 :: ((([Name L], String),[S])) -> (HappyAbsSyn ) happyIn73 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn73 #-} happyOut73 :: (HappyAbsSyn ) -> ((([Name L], String),[S])) happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut73 #-} happyIn74 :: (([Name L],[S])) -> (HappyAbsSyn ) happyIn74 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn74 #-} happyOut74 :: (HappyAbsSyn ) -> (([Name L],[S])) happyOut74 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut74 #-} happyIn75 :: (Name L) -> (HappyAbsSyn ) happyIn75 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn75 #-} happyOut75 :: (HappyAbsSyn ) -> (Name L) happyOut75 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut75 #-} happyIn76 :: (Annotation L) -> (HappyAbsSyn ) happyIn76 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn76 #-} happyOut76 :: (HappyAbsSyn ) -> (Annotation L) happyOut76 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut76 #-} happyIn77 :: (Type L) -> (HappyAbsSyn ) happyIn77 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn77 #-} happyOut77 :: (HappyAbsSyn ) -> (Type L) happyOut77 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut77 #-} happyIn78 :: (PType L) -> (HappyAbsSyn ) happyIn78 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn78 #-} happyOut78 :: (HappyAbsSyn ) -> (PType L) happyOut78 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut78 #-} happyIn79 :: (Type L) -> (HappyAbsSyn ) happyIn79 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn79 #-} happyOut79 :: (HappyAbsSyn ) -> (Type L) happyOut79 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut79 #-} happyIn80 :: (PType L) -> (HappyAbsSyn ) happyIn80 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn80 #-} happyOut80 :: (HappyAbsSyn ) -> (PType L) happyOut80 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut80 #-} happyIn81 :: (Type L) -> (HappyAbsSyn ) happyIn81 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn81 #-} happyOut81 :: (HappyAbsSyn ) -> (Type L) happyOut81 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut81 #-} happyIn82 :: (PType L) -> (HappyAbsSyn ) happyIn82 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn82 #-} happyOut82 :: (HappyAbsSyn ) -> (PType L) happyOut82 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut82 #-} happyIn83 :: (Type L) -> (HappyAbsSyn ) happyIn83 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn83 #-} happyOut83 :: (HappyAbsSyn ) -> (Type L) happyOut83 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut83 #-} happyIn84 :: (PType L) -> (HappyAbsSyn ) happyIn84 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn84 #-} happyOut84 :: (HappyAbsSyn ) -> (PType L) happyOut84 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut84 #-} happyIn85 :: (QName L) -> (HappyAbsSyn ) happyIn85 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn85 #-} happyOut85 :: (HappyAbsSyn ) -> (QName L) happyOut85 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut85 #-} happyIn86 :: (QName L) -> (HappyAbsSyn ) happyIn86 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn86 #-} happyOut86 :: (HappyAbsSyn ) -> (QName L) happyOut86 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut86 #-} happyIn87 :: (QName L) -> (HappyAbsSyn ) happyIn87 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn87 #-} happyOut87 :: (HappyAbsSyn ) -> (QName L) happyOut87 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut87 #-} happyIn88 :: (Type L) -> (HappyAbsSyn ) happyIn88 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn88 #-} happyOut88 :: (HappyAbsSyn ) -> (Type L) happyOut88 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut88 #-} happyIn89 :: (PType L) -> (HappyAbsSyn ) happyIn89 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn89 #-} happyOut89 :: (HappyAbsSyn ) -> (PType L) happyOut89 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut89 #-} happyIn90 :: (PContext L) -> (HappyAbsSyn ) happyIn90 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn90 #-} happyOut90 :: (HappyAbsSyn ) -> (PContext L) happyOut90 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut90 #-} happyIn91 :: (([PType L],[S])) -> (HappyAbsSyn ) happyIn91 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn91 #-} happyOut91 :: (HappyAbsSyn ) -> (([PType L],[S])) happyOut91 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut91 #-} happyIn92 :: (([PType L],[S])) -> (HappyAbsSyn ) happyIn92 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn92 #-} happyOut92 :: (HappyAbsSyn ) -> (([PType L],[S])) happyOut92 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut92 #-} happyIn93 :: (([TyVarBind L],Maybe L)) -> (HappyAbsSyn ) happyIn93 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn93 #-} happyOut93 :: (HappyAbsSyn ) -> (([TyVarBind L],Maybe L)) happyOut93 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut93 #-} happyIn94 :: (TyVarBind L) -> (HappyAbsSyn ) happyIn94 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn94 #-} happyOut94 :: (HappyAbsSyn ) -> (TyVarBind L) happyOut94 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut94 #-} happyIn95 :: (([Name L],Maybe L)) -> (HappyAbsSyn ) happyIn95 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn95 #-} happyOut95 :: (HappyAbsSyn ) -> (([Name L],Maybe L)) happyOut95 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut95 #-} happyIn96 :: (([Name L],L)) -> (HappyAbsSyn ) happyIn96 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn96 #-} happyOut96 :: (HappyAbsSyn ) -> (([Name L],L)) happyOut96 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut96 #-} happyIn97 :: (([FunDep L],[S],Maybe L)) -> (HappyAbsSyn ) happyIn97 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn97 #-} happyOut97 :: (HappyAbsSyn ) -> (([FunDep L],[S],Maybe L)) happyOut97 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut97 #-} happyIn98 :: (([FunDep L],[S],L)) -> (HappyAbsSyn ) happyIn98 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn98 #-} happyOut98 :: (HappyAbsSyn ) -> (([FunDep L],[S],L)) happyOut98 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut98 #-} happyIn99 :: (FunDep L) -> (HappyAbsSyn ) happyIn99 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn99 #-} happyOut99 :: (HappyAbsSyn ) -> (FunDep L) happyOut99 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut99 #-} happyIn100 :: (([GadtDecl L],[S],Maybe L)) -> (HappyAbsSyn ) happyIn100 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn100 #-} happyOut100 :: (HappyAbsSyn ) -> (([GadtDecl L],[S],Maybe L)) happyOut100 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut100 #-} happyIn101 :: (([GadtDecl L],[S])) -> (HappyAbsSyn ) happyIn101 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn101 #-} happyOut101 :: (HappyAbsSyn ) -> (([GadtDecl L],[S])) happyOut101 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut101 #-} happyIn102 :: (([GadtDecl L],[S])) -> (HappyAbsSyn ) happyIn102 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn102 #-} happyOut102 :: (HappyAbsSyn ) -> (([GadtDecl L],[S])) happyOut102 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut102 #-} happyIn103 :: (GadtDecl L) -> (HappyAbsSyn ) happyIn103 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn103 #-} happyOut103 :: (HappyAbsSyn ) -> (GadtDecl L) happyOut103 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut103 #-} happyIn104 :: (([QualConDecl L],[S],Maybe L)) -> (HappyAbsSyn ) happyIn104 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn104 #-} happyOut104 :: (HappyAbsSyn ) -> (([QualConDecl L],[S],Maybe L)) happyOut104 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut104 #-} happyIn105 :: (([QualConDecl L],[S],L)) -> (HappyAbsSyn ) happyIn105 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn105 #-} happyOut105 :: (HappyAbsSyn ) -> (([QualConDecl L],[S],L)) happyOut105 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut105 #-} happyIn106 :: (QualConDecl L) -> (HappyAbsSyn ) happyIn106 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn106 #-} happyOut106 :: (HappyAbsSyn ) -> (QualConDecl L) happyOut106 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut106 #-} happyIn107 :: ((Maybe [TyVarBind L], [S], Maybe L)) -> (HappyAbsSyn ) happyIn107 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn107 #-} happyOut107 :: (HappyAbsSyn ) -> ((Maybe [TyVarBind L], [S], Maybe L)) happyOut107 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut107 #-} happyIn108 :: (ConDecl L) -> (HappyAbsSyn ) happyIn108 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn108 #-} happyOut108 :: (HappyAbsSyn ) -> (ConDecl L) happyOut108 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut108 #-} happyIn109 :: ((Name L, [BangType L], L)) -> (HappyAbsSyn ) happyIn109 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn109 #-} happyOut109 :: (HappyAbsSyn ) -> ((Name L, [BangType L], L)) happyOut109 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut109 #-} happyIn110 :: ((Name L, [BangType L],L)) -> (HappyAbsSyn ) happyIn110 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn110 #-} happyOut110 :: (HappyAbsSyn ) -> ((Name L, [BangType L],L)) happyOut110 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut110 #-} happyIn111 :: (BangType L) -> (HappyAbsSyn ) happyIn111 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn111 #-} happyOut111 :: (HappyAbsSyn ) -> (BangType L) happyOut111 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut111 #-} happyIn112 :: (BangType L) -> (HappyAbsSyn ) happyIn112 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn112 #-} happyOut112 :: (HappyAbsSyn ) -> (BangType L) happyOut112 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut112 #-} happyIn113 :: (([FieldDecl L],[S])) -> (HappyAbsSyn ) happyIn113 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn113 #-} happyOut113 :: (HappyAbsSyn ) -> (([FieldDecl L],[S])) happyOut113 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut113 #-} happyIn114 :: (FieldDecl L) -> (HappyAbsSyn ) happyIn114 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn114 #-} happyOut114 :: (HappyAbsSyn ) -> (FieldDecl L) happyOut114 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut114 #-} happyIn115 :: (BangType L) -> (HappyAbsSyn ) happyIn115 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn115 #-} happyOut115 :: (HappyAbsSyn ) -> (BangType L) happyOut115 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut115 #-} happyIn116 :: (Maybe (Deriving L)) -> (HappyAbsSyn ) happyIn116 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn116 #-} happyOut116 :: (HappyAbsSyn ) -> (Maybe (Deriving L)) happyOut116 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut116 #-} happyIn117 :: (([InstHead L],[S])) -> (HappyAbsSyn ) happyIn117 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn117 #-} happyOut117 :: (HappyAbsSyn ) -> (([InstHead L],[S])) happyOut117 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut117 #-} happyIn118 :: (QName L) -> (HappyAbsSyn ) happyIn118 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn118 #-} happyOut118 :: (HappyAbsSyn ) -> (QName L) happyOut118 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut118 #-} happyIn119 :: (Kind L) -> (HappyAbsSyn ) happyIn119 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn119 #-} happyOut119 :: (HappyAbsSyn ) -> (Kind L) happyOut119 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut119 #-} happyIn120 :: (Kind L) -> (HappyAbsSyn ) happyIn120 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn120 #-} happyOut120 :: (HappyAbsSyn ) -> (Kind L) happyOut120 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut120 #-} happyIn121 :: (Kind L) -> (HappyAbsSyn ) happyIn121 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn121 #-} happyOut121 :: (HappyAbsSyn ) -> (Kind L) happyOut121 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut121 #-} happyIn122 :: ((Maybe (Kind L), [S])) -> (HappyAbsSyn ) happyIn122 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn122 #-} happyOut122 :: (HappyAbsSyn ) -> ((Maybe (Kind L), [S])) happyOut122 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut122 #-} happyIn123 :: ((Maybe [ClassDecl L],[S],Maybe L)) -> (HappyAbsSyn ) happyIn123 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn123 #-} happyOut123 :: (HappyAbsSyn ) -> ((Maybe [ClassDecl L],[S],Maybe L)) happyOut123 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut123 #-} happyIn124 :: (([ClassDecl L],[S])) -> (HappyAbsSyn ) happyIn124 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn124 #-} happyOut124 :: (HappyAbsSyn ) -> (([ClassDecl L],[S])) happyOut124 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut124 #-} happyIn125 :: (([ClassDecl L],[S])) -> (HappyAbsSyn ) happyIn125 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn125 #-} happyOut125 :: (HappyAbsSyn ) -> (([ClassDecl L],[S])) happyOut125 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut125 #-} happyIn126 :: (ClassDecl L) -> (HappyAbsSyn ) happyIn126 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn126 #-} happyOut126 :: (HappyAbsSyn ) -> (ClassDecl L) happyOut126 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut126 #-} happyIn127 :: (ClassDecl L) -> (HappyAbsSyn ) happyIn127 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn127 #-} happyOut127 :: (HappyAbsSyn ) -> (ClassDecl L) happyOut127 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut127 #-} happyIn128 :: ((Maybe [InstDecl L],[S],Maybe L)) -> (HappyAbsSyn ) happyIn128 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn128 #-} happyOut128 :: (HappyAbsSyn ) -> ((Maybe [InstDecl L],[S],Maybe L)) happyOut128 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut128 #-} happyIn129 :: (([InstDecl L],[S])) -> (HappyAbsSyn ) happyIn129 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn129 #-} happyOut129 :: (HappyAbsSyn ) -> (([InstDecl L],[S])) happyOut129 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut129 #-} happyIn130 :: (([InstDecl L],[S])) -> (HappyAbsSyn ) happyIn130 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn130 #-} happyOut130 :: (HappyAbsSyn ) -> (([InstDecl L],[S])) happyOut130 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut130 #-} happyIn131 :: (InstDecl L) -> (HappyAbsSyn ) happyIn131 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn131 #-} happyOut131 :: (HappyAbsSyn ) -> (InstDecl L) happyOut131 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut131 #-} happyIn132 :: (InstDecl L) -> (HappyAbsSyn ) happyIn132 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn132 #-} happyOut132 :: (HappyAbsSyn ) -> (InstDecl L) happyOut132 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut132 #-} happyIn133 :: (Decl L) -> (HappyAbsSyn ) happyIn133 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn133 #-} happyOut133 :: (HappyAbsSyn ) -> (Decl L) happyOut133 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut133 #-} happyIn134 :: ((Maybe (Binds L),[S])) -> (HappyAbsSyn ) happyIn134 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn134 #-} happyOut134 :: (HappyAbsSyn ) -> ((Maybe (Binds L),[S])) happyOut134 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut134 #-} happyIn135 :: ((Maybe (Type L),[S])) -> (HappyAbsSyn ) happyIn135 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn135 #-} happyOut135 :: (HappyAbsSyn ) -> ((Maybe (Type L),[S])) happyOut135 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut135 #-} happyIn136 :: (Rhs L) -> (HappyAbsSyn ) happyIn136 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn136 #-} happyOut136 :: (HappyAbsSyn ) -> (Rhs L) happyOut136 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut136 #-} happyIn137 :: (([GuardedRhs L],L)) -> (HappyAbsSyn ) happyIn137 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn137 #-} happyOut137 :: (HappyAbsSyn ) -> (([GuardedRhs L],L)) happyOut137 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut137 #-} happyIn138 :: (GuardedRhs L) -> (HappyAbsSyn ) happyIn138 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn138 #-} happyOut138 :: (HappyAbsSyn ) -> (GuardedRhs L) happyOut138 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut138 #-} happyIn139 :: (Exp L) -> (HappyAbsSyn ) happyIn139 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn139 #-} happyOut139 :: (HappyAbsSyn ) -> (Exp L) happyOut139 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut139 #-} happyIn140 :: (PExp L) -> (HappyAbsSyn ) happyIn140 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn140 #-} happyOut140 :: (HappyAbsSyn ) -> (PExp L) happyOut140 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut140 #-} happyIn141 :: (PExp L) -> (HappyAbsSyn ) happyIn141 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn141 #-} happyOut141 :: (HappyAbsSyn ) -> (PExp L) happyOut141 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut141 #-} happyIn142 :: (PExp L) -> (HappyAbsSyn ) happyIn142 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn142 #-} happyOut142 :: (HappyAbsSyn ) -> (PExp L) happyOut142 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut142 #-} happyIn143 :: (PExp L) -> (HappyAbsSyn ) happyIn143 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn143 #-} happyOut143 :: (HappyAbsSyn ) -> (PExp L) happyOut143 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut143 #-} happyIn144 :: (PExp L) -> (HappyAbsSyn ) happyIn144 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn144 #-} happyOut144 :: (HappyAbsSyn ) -> (PExp L) happyOut144 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut144 #-} happyIn145 :: ([S]) -> (HappyAbsSyn ) happyIn145 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn145 #-} happyOut145 :: (HappyAbsSyn ) -> ([S]) happyOut145 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut145 #-} happyIn146 :: ([S]) -> (HappyAbsSyn ) happyIn146 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn146 #-} happyOut146 :: (HappyAbsSyn ) -> ([S]) happyOut146 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut146 #-} happyIn147 :: (PExp L) -> (HappyAbsSyn ) happyIn147 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn147 #-} happyOut147 :: (HappyAbsSyn ) -> (PExp L) happyOut147 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut147 #-} happyIn148 :: (PExp L) -> (HappyAbsSyn ) happyIn148 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn148 #-} happyOut148 :: (HappyAbsSyn ) -> (PExp L) happyOut148 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut148 #-} happyIn149 :: (PExp L) -> (HappyAbsSyn ) happyIn149 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn149 #-} happyOut149 :: (HappyAbsSyn ) -> (PExp L) happyOut149 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut149 #-} happyIn150 :: ([Pat L]) -> (HappyAbsSyn ) happyIn150 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn150 #-} happyOut150 :: (HappyAbsSyn ) -> ([Pat L]) happyOut150 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut150 #-} happyIn151 :: (Pat L) -> (HappyAbsSyn ) happyIn151 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn151 #-} happyOut151 :: (HappyAbsSyn ) -> (Pat L) happyOut151 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut151 #-} happyIn152 :: (PExp L) -> (HappyAbsSyn ) happyIn152 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn152 #-} happyOut152 :: (HappyAbsSyn ) -> (PExp L) happyOut152 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut152 #-} happyIn153 :: (PExp L) -> (HappyAbsSyn ) happyIn153 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn153 #-} happyOut153 :: (HappyAbsSyn ) -> (PExp L) happyOut153 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut153 #-} happyIn154 :: (PExp L) -> (HappyAbsSyn ) happyIn154 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn154 #-} happyOut154 :: (HappyAbsSyn ) -> (PExp L) happyOut154 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut154 #-} happyIn155 :: ([S]) -> (HappyAbsSyn ) happyIn155 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn155 #-} happyOut155 :: (HappyAbsSyn ) -> ([S]) happyOut155 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut155 #-} happyIn156 :: (PExp L) -> (HappyAbsSyn ) happyIn156 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn156 #-} happyOut156 :: (HappyAbsSyn ) -> (PExp L) happyOut156 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut156 #-} happyIn157 :: (([Maybe (PExp L)],[S])) -> (HappyAbsSyn ) happyIn157 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn157 #-} happyOut157 :: (HappyAbsSyn ) -> (([Maybe (PExp L)],[S])) happyOut157 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut157 #-} happyIn158 :: (([Maybe (PExp L)],[S])) -> (HappyAbsSyn ) happyIn158 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn158 #-} happyOut158 :: (HappyAbsSyn ) -> (([Maybe (PExp L)],[S])) happyOut158 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut158 #-} happyIn159 :: (([PExp L],[S])) -> (HappyAbsSyn ) happyIn159 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn159 #-} happyOut159 :: (HappyAbsSyn ) -> (([PExp L],[S])) happyOut159 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut159 #-} happyIn160 :: (PExp L) -> (HappyAbsSyn ) happyIn160 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn160 #-} happyOut160 :: (HappyAbsSyn ) -> (PExp L) happyOut160 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut160 #-} happyIn161 :: (PExp L) -> (HappyAbsSyn ) happyIn161 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn161 #-} happyOut161 :: (HappyAbsSyn ) -> (PExp L) happyOut161 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut161 #-} happyIn162 :: ([PExp L]) -> (HappyAbsSyn ) happyIn162 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn162 #-} happyOut162 :: (HappyAbsSyn ) -> ([PExp L]) happyOut162 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut162 #-} happyIn163 :: (PExp L) -> (HappyAbsSyn ) happyIn163 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn163 #-} happyOut163 :: (HappyAbsSyn ) -> (PExp L) happyOut163 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut163 #-} happyIn164 :: (XName L) -> (HappyAbsSyn ) happyIn164 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn164 #-} happyOut164 :: (HappyAbsSyn ) -> (XName L) happyOut164 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut164 #-} happyIn165 :: (Loc String) -> (HappyAbsSyn ) happyIn165 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn165 #-} happyOut165 :: (HappyAbsSyn ) -> (Loc String) happyOut165 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut165 #-} happyIn166 :: (Loc String) -> (HappyAbsSyn ) happyIn166 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn166 #-} happyOut166 :: (HappyAbsSyn ) -> (Loc String) happyOut166 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut166 #-} happyIn167 :: ([ParseXAttr L]) -> (HappyAbsSyn ) happyIn167 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn167 #-} happyOut167 :: (HappyAbsSyn ) -> ([ParseXAttr L]) happyOut167 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut167 #-} happyIn168 :: (ParseXAttr L) -> (HappyAbsSyn ) happyIn168 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn168 #-} happyOut168 :: (HappyAbsSyn ) -> (ParseXAttr L) happyOut168 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut168 #-} happyIn169 :: (Maybe (PExp L)) -> (HappyAbsSyn ) happyIn169 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn169 #-} happyOut169 :: (HappyAbsSyn ) -> (Maybe (PExp L)) happyOut169 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut169 #-} happyIn170 :: (L -> PExp L) -> (HappyAbsSyn ) happyIn170 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn170 #-} happyOut170 :: (HappyAbsSyn ) -> (L -> PExp L) happyOut170 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut170 #-} happyIn171 :: (([PExp L],[S])) -> (HappyAbsSyn ) happyIn171 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn171 #-} happyOut171 :: (HappyAbsSyn ) -> (([PExp L],[S])) happyOut171 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut171 #-} happyIn172 :: (([[QualStmt L]],[S])) -> (HappyAbsSyn ) happyIn172 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn172 #-} happyOut172 :: (HappyAbsSyn ) -> (([[QualStmt L]],[S])) happyOut172 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut172 #-} happyIn173 :: (([QualStmt L],[S])) -> (HappyAbsSyn ) happyIn173 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn173 #-} happyOut173 :: (HappyAbsSyn ) -> (([QualStmt L],[S])) happyOut173 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut173 #-} happyIn174 :: (QualStmt L) -> (HappyAbsSyn ) happyIn174 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn174 #-} happyOut174 :: (HappyAbsSyn ) -> (QualStmt L) happyOut174 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut174 #-} happyIn175 :: (QualStmt L) -> (HappyAbsSyn ) happyIn175 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn175 #-} happyOut175 :: (HappyAbsSyn ) -> (QualStmt L) happyOut175 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut175 #-} happyIn176 :: (([Stmt L],[S])) -> (HappyAbsSyn ) happyIn176 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn176 #-} happyOut176 :: (HappyAbsSyn ) -> (([Stmt L],[S])) happyOut176 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut176 #-} happyIn177 :: (Stmt L) -> (HappyAbsSyn ) happyIn177 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn177 #-} happyOut177 :: (HappyAbsSyn ) -> (Stmt L) happyOut177 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut177 #-} happyIn178 :: (([Alt L],L,[S])) -> (HappyAbsSyn ) happyIn178 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn178 #-} happyOut178 :: (HappyAbsSyn ) -> (([Alt L],L,[S])) happyOut178 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut178 #-} happyIn179 :: (([Alt L],[S])) -> (HappyAbsSyn ) happyIn179 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn179 #-} happyOut179 :: (HappyAbsSyn ) -> (([Alt L],[S])) happyOut179 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut179 #-} happyIn180 :: (([Alt L],[S])) -> (HappyAbsSyn ) happyIn180 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn180 #-} happyOut180 :: (HappyAbsSyn ) -> (([Alt L],[S])) happyOut180 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut180 #-} happyIn181 :: (Alt L) -> (HappyAbsSyn ) happyIn181 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn181 #-} happyOut181 :: (HappyAbsSyn ) -> (Alt L) happyOut181 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut181 #-} happyIn182 :: (GuardedAlts L) -> (HappyAbsSyn ) happyIn182 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn182 #-} happyOut182 :: (HappyAbsSyn ) -> (GuardedAlts L) happyOut182 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut182 #-} happyIn183 :: (([GuardedAlt L],L)) -> (HappyAbsSyn ) happyIn183 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn183 #-} happyOut183 :: (HappyAbsSyn ) -> (([GuardedAlt L],L)) happyOut183 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut183 #-} happyIn184 :: (GuardedAlt L) -> (HappyAbsSyn ) happyIn184 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn184 #-} happyOut184 :: (HappyAbsSyn ) -> (GuardedAlt L) happyOut184 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut184 #-} happyIn185 :: (Pat L) -> (HappyAbsSyn ) happyIn185 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn185 #-} happyOut185 :: (HappyAbsSyn ) -> (Pat L) happyOut185 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut185 #-} happyIn186 :: (([Stmt L],L,[S])) -> (HappyAbsSyn ) happyIn186 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn186 #-} happyOut186 :: (HappyAbsSyn ) -> (([Stmt L],L,[S])) happyOut186 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut186 #-} happyIn187 :: (([Stmt L],[S])) -> (HappyAbsSyn ) happyIn187 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn187 #-} happyOut187 :: (HappyAbsSyn ) -> (([Stmt L],[S])) happyOut187 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut187 #-} happyIn188 :: (([Stmt L],[S])) -> (HappyAbsSyn ) happyIn188 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn188 #-} happyOut188 :: (HappyAbsSyn ) -> (([Stmt L],[S])) happyOut188 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut188 #-} happyIn189 :: (Stmt L) -> (HappyAbsSyn ) happyIn189 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn189 #-} happyOut189 :: (HappyAbsSyn ) -> (Stmt L) happyOut189 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut189 #-} happyIn190 :: (([PFieldUpdate L],[S])) -> (HappyAbsSyn ) happyIn190 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn190 #-} happyOut190 :: (HappyAbsSyn ) -> (([PFieldUpdate L],[S])) happyOut190 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut190 #-} happyIn191 :: (PFieldUpdate L) -> (HappyAbsSyn ) happyIn191 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn191 #-} happyOut191 :: (HappyAbsSyn ) -> (PFieldUpdate L) happyOut191 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut191 #-} happyIn192 :: (([IPBind L],[S])) -> (HappyAbsSyn ) happyIn192 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn192 #-} happyOut192 :: (HappyAbsSyn ) -> (([IPBind L],[S])) happyOut192 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut192 #-} happyIn193 :: (([IPBind L],[S])) -> (HappyAbsSyn ) happyIn193 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn193 #-} happyOut193 :: (HappyAbsSyn ) -> (([IPBind L],[S])) happyOut193 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut193 #-} happyIn194 :: (IPBind L) -> (HappyAbsSyn ) happyIn194 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn194 #-} happyOut194 :: (HappyAbsSyn ) -> (IPBind L) happyOut194 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut194 #-} happyIn195 :: (PExp L) -> (HappyAbsSyn ) happyIn195 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn195 #-} happyOut195 :: (HappyAbsSyn ) -> (PExp L) happyOut195 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut195 #-} happyIn196 :: (Name L) -> (HappyAbsSyn ) happyIn196 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn196 #-} happyOut196 :: (HappyAbsSyn ) -> (Name L) happyOut196 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut196 #-} happyIn197 :: (Name L) -> (HappyAbsSyn ) happyIn197 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn197 #-} happyOut197 :: (HappyAbsSyn ) -> (Name L) happyOut197 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut197 #-} happyIn198 :: (QName L) -> (HappyAbsSyn ) happyIn198 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn198 #-} happyOut198 :: (HappyAbsSyn ) -> (QName L) happyOut198 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut198 #-} happyIn199 :: (IPName L) -> (HappyAbsSyn ) happyIn199 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn199 #-} happyOut199 :: (HappyAbsSyn ) -> (IPName L) happyOut199 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut199 #-} happyIn200 :: (Name L) -> (HappyAbsSyn ) happyIn200 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn200 #-} happyOut200 :: (HappyAbsSyn ) -> (Name L) happyOut200 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut200 #-} happyIn201 :: (QName L) -> (HappyAbsSyn ) happyIn201 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn201 #-} happyOut201 :: (HappyAbsSyn ) -> (QName L) happyOut201 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut201 #-} happyIn202 :: (Name L) -> (HappyAbsSyn ) happyIn202 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn202 #-} happyOut202 :: (HappyAbsSyn ) -> (Name L) happyOut202 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut202 #-} happyIn203 :: (QName L) -> (HappyAbsSyn ) happyIn203 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn203 #-} happyOut203 :: (HappyAbsSyn ) -> (QName L) happyOut203 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut203 #-} happyIn204 :: (QName L) -> (HappyAbsSyn ) happyIn204 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn204 #-} happyOut204 :: (HappyAbsSyn ) -> (QName L) happyOut204 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut204 #-} happyIn205 :: (Name L) -> (HappyAbsSyn ) happyIn205 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn205 #-} happyOut205 :: (HappyAbsSyn ) -> (Name L) happyOut205 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut205 #-} happyIn206 :: (QName L) -> (HappyAbsSyn ) happyIn206 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn206 #-} happyOut206 :: (HappyAbsSyn ) -> (QName L) happyOut206 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut206 #-} happyIn207 :: (Op L) -> (HappyAbsSyn ) happyIn207 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn207 #-} happyOut207 :: (HappyAbsSyn ) -> (Op L) happyOut207 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut207 #-} happyIn208 :: (QOp L) -> (HappyAbsSyn ) happyIn208 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn208 #-} happyOut208 :: (HappyAbsSyn ) -> (QOp L) happyOut208 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut208 #-} happyIn209 :: (QOp L) -> (HappyAbsSyn ) happyIn209 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn209 #-} happyOut209 :: (HappyAbsSyn ) -> (QOp L) happyOut209 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut209 #-} happyIn210 :: (QName L) -> (HappyAbsSyn ) happyIn210 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn210 #-} happyOut210 :: (HappyAbsSyn ) -> (QName L) happyOut210 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut210 #-} happyIn211 :: (QName L) -> (HappyAbsSyn ) happyIn211 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn211 #-} happyOut211 :: (HappyAbsSyn ) -> (QName L) happyOut211 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut211 #-} happyIn212 :: (Name L) -> (HappyAbsSyn ) happyIn212 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn212 #-} happyOut212 :: (HappyAbsSyn ) -> (Name L) happyOut212 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut212 #-} happyIn213 :: (Name L) -> (HappyAbsSyn ) happyIn213 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn213 #-} happyOut213 :: (HappyAbsSyn ) -> (Name L) happyOut213 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut213 #-} happyIn214 :: (IPName L) -> (HappyAbsSyn ) happyIn214 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn214 #-} happyOut214 :: (HappyAbsSyn ) -> (IPName L) happyOut214 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut214 #-} happyIn215 :: (QName L) -> (HappyAbsSyn ) happyIn215 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn215 #-} happyOut215 :: (HappyAbsSyn ) -> (QName L) happyOut215 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut215 #-} happyIn216 :: (Name L) -> (HappyAbsSyn ) happyIn216 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn216 #-} happyOut216 :: (HappyAbsSyn ) -> (Name L) happyOut216 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut216 #-} happyIn217 :: (QName L) -> (HappyAbsSyn ) happyIn217 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn217 #-} happyOut217 :: (HappyAbsSyn ) -> (QName L) happyOut217 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut217 #-} happyIn218 :: (Name L) -> (HappyAbsSyn ) happyIn218 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn218 #-} happyOut218 :: (HappyAbsSyn ) -> (Name L) happyOut218 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut218 #-} happyIn219 :: (QName L) -> (HappyAbsSyn ) happyIn219 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn219 #-} happyOut219 :: (HappyAbsSyn ) -> (QName L) happyOut219 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut219 #-} happyIn220 :: (QName L) -> (HappyAbsSyn ) happyIn220 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn220 #-} happyOut220 :: (HappyAbsSyn ) -> (QName L) happyOut220 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut220 #-} happyIn221 :: (Name L) -> (HappyAbsSyn ) happyIn221 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn221 #-} happyOut221 :: (HappyAbsSyn ) -> (Name L) happyOut221 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut221 #-} happyIn222 :: (Name L) -> (HappyAbsSyn ) happyIn222 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn222 #-} happyOut222 :: (HappyAbsSyn ) -> (Name L) happyOut222 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut222 #-} happyIn223 :: (QName L) -> (HappyAbsSyn ) happyIn223 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn223 #-} happyOut223 :: (HappyAbsSyn ) -> (QName L) happyOut223 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut223 #-} happyIn224 :: (Literal L) -> (HappyAbsSyn ) happyIn224 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn224 #-} happyOut224 :: (HappyAbsSyn ) -> (Literal L) happyOut224 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut224 #-} happyIn225 :: (S) -> (HappyAbsSyn ) happyIn225 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn225 #-} happyOut225 :: (HappyAbsSyn ) -> (S) happyOut225 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut225 #-} happyIn226 :: (S) -> (HappyAbsSyn ) happyIn226 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn226 #-} happyOut226 :: (HappyAbsSyn ) -> (S) happyOut226 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut226 #-} happyIn227 :: (ModuleName L) -> (HappyAbsSyn ) happyIn227 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn227 #-} happyOut227 :: (HappyAbsSyn ) -> (ModuleName L) happyOut227 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut227 #-} happyIn228 :: (Name L) -> (HappyAbsSyn ) happyIn228 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn228 #-} happyOut228 :: (HappyAbsSyn ) -> (Name L) happyOut228 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut228 #-} happyIn229 :: (QName L) -> (HappyAbsSyn ) happyIn229 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn229 #-} happyOut229 :: (HappyAbsSyn ) -> (QName L) happyOut229 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut229 #-} happyIn230 :: (Name L) -> (HappyAbsSyn ) happyIn230 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn230 #-} happyOut230 :: (HappyAbsSyn ) -> (Name L) happyOut230 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut230 #-} happyIn231 :: (Name L) -> (HappyAbsSyn ) happyIn231 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn231 #-} happyOut231 :: (HappyAbsSyn ) -> (Name L) happyOut231 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut231 #-} happyIn232 :: (QName L) -> (HappyAbsSyn ) happyIn232 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn232 #-} happyOut232 :: (HappyAbsSyn ) -> (QName L) happyOut232 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut232 #-} happyIn233 :: (Name L) -> (HappyAbsSyn ) happyIn233 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn233 #-} happyOut233 :: (HappyAbsSyn ) -> (Name L) happyOut233 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut233 #-} happyInTok :: (Loc Token) -> (HappyAbsSyn ) happyInTok x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyInTok #-} happyOutTok :: (HappyAbsSyn ) -> (Loc Token) happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOutTok #-} happyActOffsets :: HappyAddr happyActOffsets = HappyA# "\x00\x00\x47\x15\xcc\x14\x0a\x0b\xe3\x1c\x65\x12\x00\x00\x00\x00\x00\x00\xf2\x06\x14\x04\x62\x07\xd7\x06\x00\x00\x35\x07\x00\x00\x00\x00\xa8\x21\x00\x00\x00\x00\x00\x00\x57\x1a\x00\x00\x43\x07\x00\x00\x00\x00\x31\x07\xd0\x06\x00\x00\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x0f\xed\x0e\xf5\x0f\x00\x00\xfa\x19\x57\x1a\x57\x1a\x57\x1a\x47\x15\x00\x00\x47\x15\x47\x15\x47\x15\xe3\x1c\x00\x00\xa5\x1e\x08\x20\x00\x00\x77\x1a\x47\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x15\x42\x07\x00\x00\x00\x00\x00\x00\x47\x15\x41\x07\x3d\x07\xfa\x19\x3d\x07\x00\x00\x49\x07\x45\x07\x3f\x07\x00\x00\x00\x00\x4c\x1b\x00\x00\x00\x00\x00\x00\xcf\x06\x00\x00\xe3\x1c\x28\x07\x00\x00\x00\x00\x00\x00\x00\x00\xf2\x1a\xa9\x1b\xd6\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x07\xc9\x06\xf0\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x0c\x57\x1a\xd7\x00\x7a\x1c\xe5\x06\x33\x07\xd8\x06\x00\x00\x00\x00\x00\x00\x7a\x1c\x2b\x07\x00\x00\x6d\x1d\x26\x07\x26\x07\x16\x00\x26\x07\x32\x07\xb8\x20\xb8\x20\x79\x1e\x00\x00\xb0\x06\xb0\x06\x00\x00\xb0\x06\x0c\x00\x00\x00\x00\x00\x1d\x07\x77\x1a\xce\x06\x74\x05\x57\x1a\xa8\x06\x00\x00\x00\x00\x00\x00\x00\x00\x3e\x00\x57\x1a\x2a\x07\x2c\x00\x00\x00\x1f\x07\x0b\x07\x26\x00\x24\x00\x00\x00\x09\x07\x98\x20\x51\x00\x98\x20\x7a\x1c\x98\x20\x98\x20\x02\x07\x60\x1b\x60\x1d\xdc\x1f\x00\x00\xcd\x06\x00\x00\x00\x00\xaa\x06\x7a\x1c\x7a\x1c\x7a\x1c\xf8\x06\xd1\x03\xd1\x03\xb0\x04\xb0\x04\x00\x00\x00\x00\x47\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x20\x40\x1d\x00\x00\x00\x00\x7a\x1c\x00\x00\x00\x00\x00\x00\x42\x05\x7a\x1c\x50\x00\x00\x00\x91\x21\xfb\x06\x00\x00\x00\x00\xbc\x02\xa3\x02\x00\x00\x00\x00\xa0\x01\x03\x07\xf7\x06\xa2\x02\x00\x07\xff\x06\x00\x00\xfe\x06\xa8\x1f\x00\x00\x00\x00\xa8\x1f\x00\x00\xa8\x1f\x00\x00\x00\x00\x94\x0b\x7a\x1c\xa8\x1f\x00\x00\x06\x07\x82\x06\x7c\x06\x00\x00\xf4\x10\xf4\x10\xdc\x06\x00\x00\x57\x1a\x00\x00\x9b\x06\xe6\x06\x00\x00\x89\x06\x1c\x00\xb9\x06\x00\x00\xda\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x05\x56\x02\xd6\x06\x00\x00\x00\x00\x09\x05\x0a\x0b\xc3\x06\xc2\x06\x83\x02\xb8\x06\xde\x06\xc8\x06\x1c\x01\x00\x00\x57\x1a\x00\x00\x9d\x19\x00\x00\xbc\x06\x7d\x01\xc4\x06\xba\x06\x00\x00\x00\x00\x47\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x1c\x00\x00\x00\x00\x00\x00\x69\x0e\x3d\x02\x00\x00\xaa\x04\xe5\x0d\x5e\x02\xcc\x06\xca\x06\xc1\x06\xc0\x06\xbf\x06\x00\x00\xbb\x06\x57\x1a\xb6\x06\xb5\x06\x60\x1d\x57\x1a\x57\x1a\x47\x15\x5e\x1e\x00\x00\x47\x15\x7a\x1c\x47\x15\x47\x15\x47\x15\x47\x15\x4d\x00\xa9\x06\x00\x00\xbe\x06\x11\x1e\x00\x00\xac\x00\x00\x00\x37\x06\x00\x00\x9e\x06\x00\x00\x07\x00\x14\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x02\x00\x00\x96\x06\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x06\x00\x00\x00\x00\x00\x00\x00\x00\x61\x0d\x00\x00\x00\x00\x55\x02\x00\x00\x00\x00\x47\x15\x47\x15\xdd\x0c\x00\x00\x00\x00\x0e\x02\x00\x00\x99\x06\x98\x06\x00\x00\x79\x10\x00\x00\x79\x10\x47\x15\xea\x11\x00\x00\x47\x15\x47\x15\x00\x00\x51\x14\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\xa4\x06\x77\x1a\xb1\x18\x00\x00\x72\x06\x00\x00\x00\x00\x00\x00\x00\x00\x47\x15\x92\x06\x3e\x06\x00\x00\x47\x15\x00\x00\x47\x15\x93\x06\x91\x06\xf4\x10\x4d\x00\x47\x15\x47\x15\x84\x06\xfd\x1d\x00\x00\x86\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x1c\x00\x00\x00\x00\xf8\x00\x00\x00\x00\x00\x7a\x1c\x00\x00\x00\x00\x00\x00\xb8\x21\x7a\x1c\x87\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x21\x42\x05\x46\x06\x27\x06\xf8\x00\x41\x06\xe1\x03\x79\x06\x01\x02\x00\x00\x21\x06\x6e\x06\x00\x00\x47\x15\x51\x14\x1a\x06\x23\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x0c\x16\x06\x00\x00\x67\x06\x76\x06\x00\x00\x6c\x06\x00\x00\x00\x00\x00\x00\x6f\x06\x3f\x17\x6d\x06\x62\x06\x4d\x00\x4d\x00\x61\x06\x00\x00\x5f\x06\x7c\x1f\x7a\x1c\xfa\x05\xf9\x05\xf0\x05\x50\x06\x5b\x06\x6b\x06\x4d\x06\x0e\x06\x5d\x06\x00\x00\x71\x20\x00\x00\x71\x20\x00\x00\x00\x00\x57\x1a\x00\x00\x5c\x06\x5a\x06\x00\x00\x00\x00\xe3\x04\x00\x00\x00\x00\x24\x06\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x06\xf6\x09\x4d\x00\xb1\x18\x23\x06\x51\x06\x59\x06\x57\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x15\x00\x21\x7a\x1c\x43\x06\x00\x00\x7a\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x1f\x00\x00\x7a\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\x05\x00\x00\x00\x00\x3c\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x1e\x38\x06\x00\x00\x00\x00\x3b\x06\x00\x00\x2e\x06\x00\x00\xa3\x07\x8d\x01\x05\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x06\x00\x00\x96\x02\x00\x00\x25\x06\x2d\x06\x00\x00\x00\x00\x00\x00\xd1\x20\x7a\x1c\x00\x00\x1b\x06\x00\x00\x7c\x0c\x00\x00\x00\x00\x00\x00\x17\x06\xf8\x00\x00\x00\x00\x00\xe0\x05\x20\x06\x00\x00\x2d\x02\xd4\x05\xc1\x05\x14\x06\x13\x06\x50\x00\x00\x00\x0d\x06\x00\x00\x1d\x06\x11\x06\x00\x00\x00\x00\x22\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\x10\x00\x00\x00\x00\x00\x00\x47\x15\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\xdc\x05\x00\x00\x04\x06\x00\x00\x0d\x05\xa8\x04\xa2\x04\x97\x04\x85\x04\x6f\x04\x60\x04\x58\x04\x49\x04\xed\x03\xdf\x03\xa9\x03\x7b\x03\x45\x03\x13\x03\x0b\x03\xe0\x02\xd5\x02\x00\x00\x0a\x0b\x07\x06\xe1\x05\x13\x01\x00\x00\x00\x00\xf5\x05\x03\x06\x00\x00\x00\x00\x00\x00\xd6\x13\x00\x00\x57\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\x00\x00\x00\x00\x00\xf4\x05\x00\x00\x00\x00\x00\x00\x37\x02\x00\x00\x00\x00\x47\x15\x00\x00\x61\x1f\x00\x00\x00\x00\x18\x06\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x15\xbf\x05\xe6\xff\xea\x11\xea\x11\x5b\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x1a\x00\x00\x00\x00\x6f\x11\x00\x06\x4d\x00\xf6\x05\x00\x00\xdf\x05\x00\x00\xf8\x00\x00\x00\x00\x00\x00\x00\xb9\x05\x00\x00\x00\x00\x00\x00\xc9\x1b\x00\x00\x00\x00\x00\x00\xf7\x05\xf8\x00\x53\x21\x00\x00\x7b\x0b\x7c\x0c\x00\x00\x00\x00\x37\x0c\xd8\x00\xef\x05\xee\x05\xf2\x1a\x48\x1f\x7b\x05\x98\x05\x00\x00\x00\x00\x8d\x01\x97\x05\x47\x15\x47\x15\x00\x00\x00\x00\xe5\x05\xd2\x05\x48\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x16\xd7\x05\x4d\x00\x47\x15\x3e\x05\xcc\x05\x2c\x19\x32\x18\xcc\x05\x00\x00\x63\x05\xc4\x05\x00\x00\x00\x00\x5f\x05\xbc\x05\x1c\x1c\x00\x00\x33\x21\xb2\x05\x52\x05\x51\x05\x5d\x05\x00\x00\x4e\x1c\x00\x00\xf5\x04\x00\x00\x00\x00\x00\x00\x00\x00\x59\x05\x00\x00\x4d\x05\x3f\x05\x80\x0a\xa9\x05\x00\x00\x00\x00\xb0\x05\xa1\x05\x00\x00\x00\x00\x00\x00\xae\x05\x00\x00\x38\x05\x00\x00\x00\x00\x00\x00\x47\x15\x93\x05\x00\x00\x00\x00\x00\x00\x35\x1c\x00\x00\x00\x00\x00\x00\x90\x05\x00\x00\x00\x00\x00\x00\x35\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x1b\x00\x00\x48\x1f\xb8\x21\x00\x00\x00\x00\xc2\x15\x99\x05\x4d\x00\x00\x00\x48\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x83\x05\x00\x00\x00\x00\x9d\x05\xee\x1e\x1e\x0c\xac\x05\x00\x00\x00\x00\x1c\x1f\x28\x05\xd9\x0b\x00\x00\x1c\x1f\x1c\x1f\x27\x05\x00\x00\x00\x00\x00\x00\x75\x01\x92\x05\x4d\x00\x88\x05\x8f\x05\x00\x00\x00\x00\x8b\x05\x91\x05\x40\x05\x00\x00\x00\x00\x00\x00\x00\x00\x79\x02\x00\x00\x1c\x00\x00\x00\x77\x05\x00\x00\x47\x15\x47\x15\x47\x15\x00\x00\x00\x00\x00\x00\x1f\x05\x50\x05\x1b\x05\x6b\x05\x00\x00\x5b\x13\x47\x15\xe0\x12\x78\x05\x47\x15\x69\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x66\x05\x30\x00\x61\x05\x00\x00\xfd\x1d\x5b\x05\x00\x00\x1c\x1f\x00\x00\x3a\x01\xb9\x02\x00\x00\x00\x00\x6c\x05\x1c\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x1c\x60\x1d\x9e\x21\x5c\x05\x35\x1c\xb3\x17\x68\x05\x0e\x05\x00\x00\x35\x1c\x00\x00\x00\x00\xe2\x1d\x6a\x05\x03\x1d\x00\x00\x17\x03\x00\x00\x00\x00\x00\x00\x71\x05\x00\x00\x26\x05\x00\x00\x77\x1a\x00\x00\x00\x00\x33\x02\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x05\x57\x05\x13\x05\xf2\x04\x00\x00\x00\x00\x35\x1c\x3a\x05\x36\x05\x35\x05\x35\x05\x41\x16\x3d\x05\x00\x00\x00\x00\x3c\x20\xc0\x0b\x1c\x1f\x1c\x1f\x35\x1c\xfd\x01\x3d\x05\x39\x05\x00\x00\x00\x00\x00\x00\x04\x02\x00\x00\x00\x00\x77\x1a\x47\x15\x00\x00\x11\x05\x47\x15\xc0\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x1f\xbc\x04\x00\x00\x00\x00\x00\x00\x00\x00\x35\x1c\x00\x00\xe7\x04\x00\x00\x00\x00\x00\x00\x00\x00\x15\x20\xe5\x04\xd6\x04\x0b\x00\x26\x05\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x04\x00\x00\x47\x15\x00\x00\x00\x00\x00\x00\x1c\x1f\x00\x00\x00\x00\x00\x00\x0f\x05\x00\x00\xc0\x1e\x00\x00\x0c\x05\xfd\x04\x00\x00\x00\x00\x00\x00\x05\x05\xc9\x1d\x02\x05\x15\x20\x00\x00\x00\x00\x00\x00\xa1\x01\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00"# happyGotoOffsets :: HappyAddr happyGotoOffsets = HappyA# "\x02\x00\x27\x28\x3e\x2b\xb2\x01\xb1\x06\xf4\x24\x01\x00\xff\xff\xfe\xff\x0c\x03\x22\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x06\x00\x00\x00\x00\x00\x00\xb5\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x28\xb2\x28\x92\x28\x00\x00\x9e\x16\x9f\x31\x93\x17\x67\x31\x28\x2b\x00\x00\xd9\x27\xc1\x27\xd8\x2f\x9d\x06\x39\x04\x7d\x02\x87\x05\x00\x00\xf1\x03\x26\x2f\x70\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x2f\x9c\xff\x00\x00\x00\x00\x00\x00\xc2\x2e\x0a\x00\x92\xff\x5b\x19\x90\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x04\xbf\x04\x8f\x08\x00\x00\x00\x00\x00\x00\xb3\x04\x00\x00\xcd\x04\x00\x00\x46\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd7\x09\x51\x31\x00\x00\x03\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xef\x07\xf5\xff\x00\x00\x32\x08\xca\x04\xc5\x04\xba\x04\xb1\x04\xd4\x04\x83\x03\x59\x02\x2e\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x01\x00\x00\x00\x00\xfc\xff\xe3\x03\xe0\x04\x19\x04\x19\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x01\x03\x31\x17\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x04\x85\x02\x00\x00\x54\x02\xbb\x07\xc8\x01\x99\x01\x00\x00\xad\x08\x7b\x08\xce\x03\x00\x00\x00\x00\x1b\x00\x10\x00\x6d\x04\xa7\x07\x49\x01\x93\x07\x80\x04\x9e\x04\x9a\x04\xf9\x03\xd4\x03\x00\x00\x00\x00\xc2\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\xf0\x03\x00\x00\x00\x00\x69\x06\x00\x00\x00\x00\x00\x00\xb3\x01\x55\x06\xec\xff\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x03\x00\x00\x00\x00\x87\x02\x00\x00\x16\x01\x00\x00\x00\x00\x20\x01\x64\x07\xad\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x24\x0a\x24\x00\x00\x00\x00\xcb\x30\x00\x00\x00\x00\x35\x04\x00\x00\x00\x00\xa5\x00\x00\x00\x09\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\x8c\xff\x12\x04\x00\x00\x00\x00\x00\x00\x2b\x02\x2c\x01\x00\x00\x00\x00\x06\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x30\x00\x00\x59\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x03\x00\x00\x00\x00\x00\x00\x0b\x2a\x76\x01\x00\x00\x00\x00\xed\x29\xce\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x17\x00\x00\x00\x00\x21\x08\x7d\x30\x67\x30\x73\x27\xa3\x00\x00\x00\xc2\x2f\x12\x06\xac\x2e\x5e\x2e\x48\x2e\xfa\x2d\xd9\x03\x00\x00\x50\x04\x0f\x00\xb6\x00\x00\x00\xdf\x02\x00\x00\x00\x00\x41\x04\x00\x00\x00\x00\x00\x00\x8d\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\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x29\x00\x00\x00\x00\x10\x01\x00\x00\x00\x00\xda\x2a\xe4\x2d\x7a\x29\x00\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x25\x29\x00\x00\x07\x29\x96\x2d\x9a\x21\x00\x00\x80\x2d\x32\x2d\x00\x00\xbc\x23\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x03\x3d\x04\x00\x00\x00\x00\x89\x03\x2f\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x2a\x7f\xff\x00\x00\x00\x00\x1c\x2d\x00\x00\xce\x2c\x00\x00\xdd\x03\x6e\x23\xa2\x03\xb8\x2c\x6a\x2c\x00\x00\xd1\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x07\x00\x00\x00\x00\xcb\x03\x00\x00\x00\x00\x08\x07\x00\x00\x00\x00\x00\x00\x14\x01\xf4\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\x02\xa2\x01\xfe\x03\x0a\x04\x91\x03\xcf\x03\x00\x00\x00\x00\x00\x00\x00\x00\xf2\x03\xbf\x03\x00\x00\x5b\x27\x20\x23\xef\x03\x05\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\xff\xc3\x03\xb0\x01\xe8\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x03\x39\x02\x00\x00\x00\x00\x43\x03\x2e\x03\x00\x00\x00\x00\x81\x03\xb6\x04\xfe\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x03\xa5\x03\x00\x00\x9c\x03\x00\x00\x8e\x01\x00\x00\x00\x00\x71\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x03\x00\x00\x00\x00\x00\x00\x33\x03\x00\x00\xec\x03\xd2\x03\x00\x00\x65\x00\xe7\x02\x19\x30\xae\x03\xa6\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x2f\xdc\xff\xc4\x03\x00\x00\x00\x00\xa8\x03\x00\x00\x00\x00\x00\x00\x00\x00\xd1\x01\x00\x00\xca\x05\x00\x00\x00\x00\x00\x00\x00\x00\xba\x03\x00\x00\x58\x06\xad\x03\x00\x00\x00\x00\x00\x00\x27\x00\x25\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\xd7\x02\x00\x00\x00\x00\x00\x00\x85\x00\xd3\x02\xdb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe7\xff\x00\x00\x00\x00\x00\x00\xc0\x00\xb6\x05\x00\x00\x00\x00\x00\x00\xba\x08\x2a\x03\x00\x00\x00\x00\x00\x00\x1f\x03\x00\x00\x00\x00\x32\x03\x95\x02\x00\x00\xaa\xff\x06\x03\x08\x03\x00\x00\x00\x00\xa7\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\xd2\x22\x00\x00\x00\x00\x00\x00\x54\x2c\x00\x00\x20\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x06\x2c\x00\x00\xd4\x00\x00\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\xf0\x2b\x00\x00\x00\x00\x36\x22\xe8\x21\xa6\x24\x00\x00\x00\x00\x00\x00\xc3\x02\x00\x00\xb8\x19\x00\x00\x00\x00\x60\x2a\x00\x00\x75\x02\xb8\x02\x00\x00\x00\x00\x00\x00\x58\x03\x00\x00\x00\x00\x00\x00\xbb\x02\x00\x00\x00\x00\x00\x00\xab\x04\x3c\x00\x23\x00\x00\x00\x00\x00\xab\x02\x31\x00\x00\x00\xd1\x01\xce\x08\x00\x00\x00\x00\xa7\x06\x82\xff\x00\x00\x00\x00\xf8\x03\x1a\x09\x00\x00\x24\x03\x00\x00\x00\x00\x38\x02\x00\x00\xf5\x26\xa7\x26\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x03\x5d\x00\x1e\x00\x69\x01\x00\x00\x02\x03\x01\x03\x00\x00\x3c\x02\x8f\x26\xdf\x00\x00\x00\x12\x17\xb5\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\xff\x00\x00\x6f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\x00\x00\x44\x03\x00\x00\x00\x00\xea\x02\x00\x00\xdc\x02\x00\x00\x7b\x00\x00\x00\x61\x02\x00\x00\x00\x00\xd4\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x02\x00\x00\x00\x00\x00\x00\x41\x26\x00\x00\x00\x00\x00\x00\x00\x00\x69\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x05\x00\x00\x12\x03\x00\x00\x00\x00\x00\x00\x58\x06\x00\x00\x3f\x02\x74\xff\x00\x00\x00\x00\x21\x02\x00\x00\xf6\x01\x00\x00\xd6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x02\x5d\x04\xf5\x01\x00\x00\x00\x00\x15\x09\x00\x00\xd1\x01\x00\x00\x9b\x00\x09\x09\x00\x00\x00\x00\x00\x00\x00\x00\x19\x01\x00\x00\xc5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x02\x00\x00\xfe\x02\x00\x00\xf1\xff\x00\x00\x00\x00\x00\x00\x29\x26\xdb\x25\xc3\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x02\xe2\x01\x00\x00\x84\x22\x75\x25\x76\x2a\x00\x00\xa2\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x02\x00\x00\x00\x00\x2a\x00\x00\x00\x00\x00\xd1\x01\x00\x00\x00\x00\xd1\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x09\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x00\x00\xc5\x06\x62\x01\x00\x00\x00\x00\x73\x05\x19\x03\x00\x00\x44\x01\x00\x00\x5e\x05\x00\x00\x00\x00\x5c\x00\x00\x00\x11\x00\x00\x00\xb6\xff\x00\x00\x00\x00\x00\x00\x5c\x02\x00\x00\x85\x01\x00\x00\xfb\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x01\x9a\x01\x00\x00\x00\x00\x17\x05\x00\x00\x00\x00\x0f\x01\xf7\x00\x9d\x02\x00\x00\x00\x00\x00\x00\xbd\x00\x68\x04\xf8\x08\xf3\x08\x03\x05\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\x02\x5d\x25\x00\x00\x00\x00\x0f\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd3\x04\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\xef\xff\x00\x00\xb4\x00\x57\x02\xa7\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8c\x2b\x00\x00\x00\x00\x00\x00\x9f\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\xff\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x00\x00\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyDefActions :: HappyAddr happyDefActions = HappyA# "\x98\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\xfd\x98\xfd\x00\x00\xe5\xff\xed\xff\x00\x00\x00\x00\xf9\xfd\xc0\xfe\xbe\xfe\xb8\xfe\xb7\xfe\xb5\xfe\xb3\xfe\xae\xfe\xa5\xfe\xa0\xfe\x98\xfe\x94\xfe\x82\xfe\x00\x00\x00\x00\x91\xfe\x92\xfe\x93\xfe\xe9\xfd\xe4\xfd\xbe\xfd\xcb\xfd\xe2\xfd\xdf\xfd\xb6\xfd\x90\xfe\xc9\xfd\xca\xfd\xb8\xfd\xb7\xfd\xb4\xfd\xb5\xfd\xa2\xfd\xa0\xfd\xa1\xfd\x9f\xfd\x9e\xfd\x9d\xfd\x9c\xfd\x9b\xfd\x9a\xfd\x99\xfd\x00\x00\x00\x00\x00\x00\x86\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x98\xfd\x00\x00\x00\x00\x77\xfe\x00\x00\x00\x00\x62\xfe\xc5\xfd\xbd\xfd\xbc\xfd\xbb\xfd\xc4\xfd\xc3\xfd\xc2\xfd\xc1\xfd\xc0\xfd\xbf\xfd\xc8\xfd\x00\x00\x98\xfd\xb9\xfd\xba\xfd\xc6\xfd\x00\x00\x98\xfd\x98\xfd\x00\x00\x98\xfd\xc7\xfd\x00\x00\x00\x00\x00\x00\x41\xff\x27\xff\x48\xff\x3e\xff\x3c\xff\x35\xff\x00\x00\x2a\xff\x00\x00\x00\x00\x90\xfd\x2e\xff\x3b\xff\x91\xfd\x00\x00\x00\x00\x00\x00\x8f\xfd\x8e\xfd\x8d\xfd\x20\xff\x85\xff\xad\xff\x00\x00\x00\x00\x90\xff\x86\xff\x7f\xff\x84\xff\x97\xff\xb7\xfe\x00\x00\x00\x00\x00\x00\x8f\xff\x00\x00\x00\x00\xab\xff\xaa\xff\xa9\xff\x00\x00\x98\xfd\x8e\xff\x00\x00\x5e\xff\x5e\xff\x5e\xff\x5e\xff\x60\xff\x52\xff\x52\xff\x00\x00\x04\xfe\x00\x00\x00\x00\xc0\xfe\x00\x00\xe5\xff\xf4\xff\xf2\xff\x98\xfd\x00\x00\xe5\xff\x00\x00\x00\x00\x00\x00\x4d\xff\x4e\xff\xe8\xfd\xe1\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x53\xff\x00\x00\x50\xff\x00\x00\x00\x00\x61\xff\x5e\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\xff\x00\x00\x00\x00\x76\xff\x00\x00\xd9\xff\xd9\xff\xd6\xfe\x00\x00\x8b\xff\x00\x00\x1a\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd1\xfd\xd0\xfd\x00\x00\xd5\xfd\xcc\xfd\xb3\xfd\xdb\xfd\xb0\xfd\xaf\xfd\xac\xfd\xb1\xfd\xa3\xfd\xb2\xfd\x00\x00\x00\x00\xa9\xfd\xcd\xfd\x00\x00\xab\xfd\xaa\xfd\xa8\xfd\xe6\xfe\x00\x00\x00\x00\xac\xff\x00\x00\x00\x00\x32\xff\x23\xff\x00\x00\x00\x00\x30\xff\x75\xfe\x23\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\xff\x00\x00\x00\x00\x28\xff\x3f\xff\x00\x00\x2b\xff\x00\x00\x8b\xfd\x8a\xfd\x00\x00\x00\x00\x00\x00\x26\xff\x00\x00\x00\x00\x00\x00\xf8\xfd\xfe\xfd\xfe\xfd\x00\x00\x9d\xfe\x00\x00\xa6\xfe\xfb\xfd\xac\xfe\xa7\xfe\x00\x00\xaa\xfe\x00\x00\x2c\xfe\x5d\xfe\x59\xfe\x5c\xfe\x5b\xfe\x5a\xfe\x55\xfe\x54\xfe\x53\xfe\x52\xfe\x51\xfe\x50\xfe\x4f\xfe\x4e\xfe\x4d\xfe\x4c\xfe\x4b\xfe\x4a\xfe\x49\xfe\x48\xfe\x57\xfe\x56\xfe\x47\xfe\x46\xfe\x45\xfe\x44\xfe\x43\xfe\x42\xfe\x41\xfe\x40\xfe\x3f\xfe\x3e\xfe\x3d\xfe\x3c\xfe\x3b\xfe\x3a\xfe\x39\xfe\x38\xfe\x37\xfe\x36\xfe\x35\xfe\x34\xfe\x33\xfe\x32\xfe\x31\xfe\x58\xfe\x30\xfe\x2f\xfe\x2e\xfe\x78\xfe\x79\xfe\x00\x00\x00\x00\x00\x00\x7b\xfe\x7a\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xb7\xfe\x00\x00\x00\x00\x6a\xfe\x00\x00\x03\xfe\xa8\xfe\x99\xfe\x00\x00\x9e\xfe\x74\xfe\x28\xfe\x00\x00\x27\xfe\xcf\xfd\xce\xfd\x00\x00\xd9\xfd\xae\xfd\xad\xfd\xa7\xfd\xed\xfd\x00\x00\xa5\xfd\xa6\xfd\xa4\xfd\x00\x00\x00\x00\xeb\xfd\x74\xfe\x00\x00\x00\x00\x00\x00\xd5\xfd\x00\x00\xad\xfd\xa7\xfd\xee\xfd\xa5\xfd\xab\xfd\xa6\xfd\xa4\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\x00\x00\x00\x00\xf7\xff\xe5\xff\xf6\xff\x00\x00\xd9\xff\xe8\xff\xda\xff\x00\x00\xed\xff\xef\xff\x96\xfd\x97\xfd\xb9\xfe\xba\xfe\xbb\xfe\xbc\xfe\xbf\xfe\xb6\xfe\xb4\xfe\x00\x00\xf6\xfd\xf4\xfd\x00\x00\x97\xfe\xf3\xfd\xfa\xfd\x9a\xfe\x9b\xfe\x00\x00\x43\xff\xe3\xfd\xde\xfd\x85\xfe\x00\x00\x8e\xfe\x8f\xfe\x00\x00\xec\xfd\x76\xfe\x00\x00\x00\x00\x00\x00\x8b\xfe\x8a\xfe\x00\x00\xea\xfd\x00\x00\x00\x00\x73\xfe\x00\x00\x87\xfe\x00\x00\x26\xfe\x00\x00\x9f\xfe\x00\x00\x00\x00\x84\xfe\x00\x00\x80\xfe\x7f\xfe\x7e\xfe\x7d\xfe\x00\x00\xd9\xff\xa4\xff\x00\x00\x00\x00\x29\xfe\x65\xfe\x00\x00\x5f\xfe\x63\xfe\xab\xfe\x61\xfe\x00\x00\x98\xfd\x00\x00\xad\xfe\x00\x00\x9c\xfe\x00\x00\x00\x00\xfc\xfd\xfe\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x44\xff\x45\xff\x00\x00\x46\xff\x47\xff\x42\xff\x33\xff\x2c\xff\x2d\xff\x31\xff\x00\x00\x3a\xff\x37\xff\x00\x00\x2f\xff\x39\xff\x00\x00\x38\xff\x21\xff\x1f\xff\x00\x00\x00\x00\xae\xff\xd3\xfd\xd2\xfd\xa7\xff\xd7\xfd\xdd\xfd\x00\x00\xe6\xfe\xf2\xfe\x13\xff\x00\x00\x08\xff\x81\xff\x00\x00\x00\x00\x72\xff\xc8\xfe\xc4\xfe\xc2\xfe\x00\x00\x00\x00\xc8\xfe\x66\xff\x71\xff\x70\xff\x6f\xff\x6e\xff\x6d\xff\x6c\xff\x6b\xff\x00\x00\xe2\xfe\x1c\xff\xe6\xfe\x00\x00\x8c\xff\x43\xff\x8d\xff\x99\xff\x9a\xff\x98\xfd\x89\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\xff\xe6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\xff\x62\xff\x94\xff\x54\xff\x93\xff\x00\x00\x51\xff\x92\xff\x00\x00\x4b\xff\x00\x00\x00\x00\x91\xff\x4a\xff\xe2\xff\x95\xfd\x94\xfd\x00\x00\x2c\xfe\xe7\xff\xd9\xff\xd9\xff\x00\x00\xdc\xff\x00\x00\x29\xfe\x00\x00\xd7\xff\x00\x00\x00\x00\xe7\xfd\xe0\xfd\x4c\xff\x4f\xff\x55\xff\x63\xff\x00\x00\x00\x00\x00\x00\x00\x00\x5d\xff\x00\x00\x7a\xff\x7d\xff\x7e\xff\xa3\xff\x44\xff\xa2\xff\x00\x00\x74\xff\x82\xff\x75\xff\x83\xff\xd9\xff\x87\xff\xc6\xfe\xd9\xff\xf0\xfd\x93\xfe\xdb\xff\xd9\xff\xd9\xff\x98\xff\x9e\xff\x00\x00\x19\xff\x17\xff\x9b\xff\x98\xfd\x95\xff\x00\x00\xe6\xfd\x00\x00\x00\x00\x00\x00\x6a\xff\x69\xff\x68\xff\x67\xff\xca\xfe\x98\xfd\x11\xfe\x00\x00\x13\xfe\x00\x00\x98\xfd\xc5\xfe\xc3\xfe\xcb\xfe\x00\x00\x00\x00\xda\xfd\x0e\xff\x0c\xff\x00\x00\x20\xff\xe5\xfe\xec\xfe\xeb\xfe\x00\x00\xe8\xfe\xe9\xfe\xf2\xfe\x98\xfd\xa0\xff\x00\x00\xf2\xfe\x13\xff\x00\x00\x00\x00\x00\x00\x29\xff\x00\x00\x22\xff\x00\x00\x24\xff\x8c\xfd\x25\xff\x00\x00\xa3\xfe\xa4\xfe\x01\xfe\xff\xfd\x00\xfe\xfe\xfd\x02\xfe\xaf\xfe\xb1\xfe\x00\x00\xa9\xfe\xd9\xff\xd9\xff\x6a\xfe\x00\x00\x00\x00\x2a\xfe\x00\x00\x2d\xfe\x00\x00\xc9\xfd\xb4\xfd\xc5\xfd\xbd\xfd\xbc\xfd\xbb\xfd\xc4\xfd\xc3\xfd\xc2\xfd\xc1\xfd\xc0\xfd\xbf\xfd\xc8\xfd\xb9\xfd\xba\xfd\xc6\xfd\xc7\xfd\x5e\xfe\xda\xff\xa6\xff\x00\x00\x00\x00\x6b\xfe\xb2\xfe\x22\xfe\x1e\xfe\x1c\xfe\x1b\xfe\x1a\xfe\x00\x00\x24\xfe\x74\xfe\x20\xfe\x21\xfe\xd4\xfd\xd8\xfd\x88\xfe\x89\xfe\x00\x00\x6c\xfe\x72\xfe\x68\xfe\x69\xfe\x8c\xfe\x8d\xfe\x00\x00\x6f\xfe\x95\xfe\x00\x00\x96\xfe\x00\x00\xee\xff\xeb\xff\x00\x00\x00\x00\xea\xff\xec\xff\xe9\xff\xf7\xfd\xf5\xfd\x71\xfe\x70\xfe\x6e\xfe\x6d\xfe\x25\xfe\x19\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x83\xfe\x7c\xfe\xa5\xff\x62\xfe\x66\xfe\x00\x00\x64\xfe\x60\xfe\x00\x00\x00\x00\x00\x00\xac\xfe\xfd\xfd\x00\x00\x36\xff\x00\x00\xa8\xff\xd6\xfd\xdc\xfd\xf2\xfe\x9d\xff\xf1\xfe\xed\xfe\x00\x00\xd9\xff\xd9\xff\x9f\xff\x00\x00\x00\x00\x00\x00\xfb\xfe\x03\xff\x00\x00\x0a\xff\x07\xff\x02\xff\x00\x00\x00\x00\x2e\xff\x00\x00\x00\x00\x00\x00\x08\xff\x80\xff\x73\xff\x00\x00\x10\xfe\x00\x00\x00\x00\xc9\xfe\x96\xff\x00\x00\x00\x00\x00\x00\xd9\xff\xd9\xff\x1c\xff\x1d\xff\x1c\xff\xd4\xfe\x00\x00\x00\x00\x00\x00\xda\xff\xf2\xfd\x00\x00\xda\xff\x8a\xff\xa1\xff\x00\x00\x79\xff\x77\xff\x5c\xff\x00\x00\x00\x00\x59\xff\x57\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\xff\xd3\xff\xf3\xff\x00\x00\xe0\xff\xd9\xff\xc9\xff\xde\xff\xc6\xff\xe1\xff\xc4\xff\x00\x00\xda\xff\xdd\xff\x62\xfe\xf0\xff\x00\x00\xd3\xff\xd1\xff\xd0\xff\x92\xfd\xcf\xff\xd4\xff\x00\x00\xe6\xff\xe4\xff\xe3\xff\x00\x00\x00\x00\x58\xff\x5a\xff\x7b\xff\x00\x00\x7c\xff\x88\xff\xf1\xfd\x00\x00\xef\xfd\xd7\xfe\xd8\xfe\x00\x00\xcf\xfe\xd9\xff\xd2\xfe\xd0\xfe\xd1\xfe\xc6\xfe\x8f\xff\x00\x00\x00\x00\x16\xff\x18\xff\xe0\xfe\x00\x00\x00\x00\x64\xff\x00\x00\xe5\xfd\xc1\xfe\x12\xfe\x0d\xff\x00\x00\xfa\xfe\x3d\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfe\xfe\xff\xfe\x00\x00\x00\x00\x03\xff\x0b\xff\x00\x00\x00\x00\x00\x00\x09\xff\xea\xfe\xe7\xfe\x00\x00\x00\x00\x00\x00\xee\xfe\x00\x00\xf0\xfe\x9c\xff\x00\x00\x00\x00\x00\x00\x0e\xfe\x0f\xfe\xd9\xff\x0b\xfe\x00\x00\x2b\xfe\xaa\xfe\x14\xfe\x1f\xfe\x1d\xfe\x00\x00\x00\x00\x00\x00\x23\xfe\x18\xfe\x16\xfe\x17\xfe\x00\x00\xc8\xfe\x08\xfe\x06\xfe\x00\x00\x00\x00\xda\xff\x0d\xfe\x00\x00\x00\x00\x1e\xff\xef\xfe\x14\xff\x15\xff\xd9\xff\x10\xff\x00\x00\x00\x00\x00\x00\x01\xff\x00\x00\x00\x00\xfd\xfe\x40\xff\x06\xff\x00\x00\x00\x00\xf7\xfe\x05\xff\x2d\xff\x00\x00\x65\xff\xe3\xfe\xe4\xfe\xdd\xfe\xd9\xff\xde\xfe\xdc\xfe\x00\x00\x00\x00\x1b\xff\x00\x00\x00\x00\xda\xff\xd5\xfe\xe6\xfe\x78\xff\x00\x00\x5f\xff\xcb\xff\x00\x00\x00\x00\xd4\xff\xd5\xff\x00\x00\xca\xff\xdf\xff\xc7\xff\xc2\xff\xc5\xff\x00\x00\xc3\xff\x00\x00\xd2\xff\xd6\xff\x00\x00\xb1\xff\xb0\xff\xaf\xff\xcd\xff\x00\x00\x00\x00\xf2\xfe\x13\xff\xd3\xfe\xc7\xfe\x00\x00\x00\x00\x41\xff\xe6\xfe\xe6\xfe\xda\xff\xe1\xfe\xf9\xfe\x04\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xda\xff\x12\xff\x00\x00\xb0\xfe\x0c\xfe\x09\xfe\x00\x00\x07\xfe\x0a\xfe\x00\x00\x00\x00\x15\xfe\x00\x00\x00\x00\x00\x00\x11\xff\x0f\xff\x00\xff\xfc\xfe\xf5\xfe\xf6\xfe\x00\x00\x00\x00\xf8\xfe\xdf\xfe\xd9\xfe\xdb\xfe\x00\x00\xce\xfe\xf2\xfe\xcd\xfe\x56\xff\xce\xff\xcc\xff\x00\x00\x00\x00\xc0\xff\xbe\xff\x00\x00\xf1\xff\xb2\xff\xcc\xfe\xda\xfe\x00\x00\xf4\xfe\x00\x00\x05\xfe\x67\xfe\xa2\xfe\x00\x00\xc1\xff\xc8\xff\xbf\xff\x00\x00\xbb\xff\xd3\xff\xf3\xfe\x00\x00\xd3\xff\xb8\xff\xb7\xff\x93\xfd\xb6\xff\x00\x00\x00\x00\xd4\xff\xbc\xff\xb9\xff\xbd\xff\x00\x00\xb4\xff\x00\x00\xb5\xff\xb3\xff"# happyCheck :: HappyAddr happyCheck = HappyA# "\xff\xff\x00\x00\x04\x00\x04\x00\x02\x00\x04\x00\x04\x00\x0b\x00\x11\x00\x12\x00\x13\x00\x3b\x00\x3c\x00\x07\x00\x11\x00\x20\x00\x24\x00\x36\x00\x0d\x00\x0e\x00\x2d\x00\x6b\x00\x07\x00\x3b\x00\x3c\x00\x32\x00\x1d\x00\x1e\x00\x90\x00\x0d\x00\x0e\x00\x1c\x00\x2d\x00\x16\x00\x2d\x00\x1c\x00\x13\x00\x32\x00\xa7\x00\x32\x00\x0d\x00\x0e\x00\x22\x00\x0d\x00\x0e\x00\x0d\x00\x0e\x00\x36\x00\x0d\x00\x0e\x00\x0d\x00\x0e\x00\x0d\x00\x0e\x00\x20\x00\x2d\x00\x1c\x00\x09\x00\x2a\x00\x0b\x00\x32\x00\xc9\x00\x11\x00\xaf\x00\x1c\x00\xaf\x00\x1c\x00\x5d\x00\xc2\x00\x2a\x00\x08\x00\x09\x00\x1c\x00\x0d\x00\x0e\x00\xaf\x00\x96\x00\x00\x00\x98\x00\xdb\x00\xdc\x00\xcf\x00\x46\x00\xc7\x00\x48\x00\xd6\x00\x4e\x00\x27\x00\x08\x00\x09\x00\xce\x00\xcf\x00\xd0\x00\x0c\x00\xd2\x00\x79\x00\xd4\x00\x45\x00\x46\x00\x25\x00\x48\x00\x49\x00\xd6\x00\x1e\x00\xd6\x00\x4d\x00\x0d\x00\x0e\x00\x1f\x00\x1f\x00\x20\x00\x31\x00\x32\x00\x33\x00\xd6\x00\x68\x00\x24\x00\x25\x00\xcc\x00\xcd\x00\x87\x00\x14\x00\x15\x00\x1f\x00\x20\x00\x5a\x00\x72\x00\xd8\x00\x2f\x00\x31\x00\x32\x00\x33\x00\x53\x00\x6f\x00\x21\x00\x96\x00\x23\x00\x98\x00\x25\x00\x26\x00\x27\x00\x28\x00\x8b\x00\x71\x00\x15\x00\x2c\x00\x8b\x00\x2e\x00\x2f\x00\xba\x00\x5a\x00\x0d\x00\x0e\x00\xc9\x00\xca\x00\x76\x00\x21\x00\x76\x00\x23\x00\x5c\x00\x25\x00\x26\x00\x27\x00\x28\x00\xc9\x00\xc9\x00\xca\x00\x2c\x00\xb9\x00\x2e\x00\x2f\x00\xbf\x00\xbd\x00\xa8\x00\xc2\x00\x8b\x00\xc4\x00\x8b\x00\xbb\x00\xba\x00\x33\x00\xbe\x00\xb9\x00\x8b\x00\xc9\x00\xca\x00\xbd\x00\xcf\x00\xcd\x00\xd6\x00\xd2\x00\xc8\x00\xc9\x00\xca\x00\xc9\x00\xcc\x00\xcd\x00\xb5\x00\xc9\x00\xca\x00\xa8\x00\xd6\x00\xcd\x00\xd6\x00\xbb\x00\x19\x00\x71\x00\xbe\x00\xb5\x00\xda\x00\xd6\x00\xcd\x00\xd6\x00\xd6\x00\xd9\x00\xd6\x00\xd6\x00\xc8\x00\xc9\x00\xca\x00\xcd\x00\xcc\x00\xcd\x00\x7a\x00\xd6\x00\x09\x00\x47\x00\x19\x00\x49\x00\x4a\x00\x4b\x00\x82\x00\x83\x00\x84\x00\x85\x00\xda\x00\x22\x00\x88\x00\x89\x00\x8a\x00\x33\x00\xc7\x00\x8d\x00\x8e\x00\x8f\x00\x7a\x00\x40\x00\x41\x00\xce\x00\xcf\x00\xc9\x00\x96\x00\x24\x00\x82\x00\x83\x00\x84\x00\x85\x00\xbe\x00\xb9\x00\x88\x00\x89\x00\x8a\x00\xbd\x00\xb9\x00\x8d\x00\x8e\x00\x8f\x00\xbd\x00\xdb\x00\xdc\x00\x16\x00\xcc\x00\xcd\x00\x96\x00\xc9\x00\xca\x00\x1a\x00\xb9\x00\xcd\x00\xc9\x00\xca\x00\xbd\x00\x69\x00\xcd\x00\x90\x00\xb8\x00\x72\x00\x93\x00\xbb\x00\xbc\x00\xd9\x00\xbe\x00\x67\x00\xc9\x00\xca\x00\x50\x00\x2e\x00\xcd\x00\x32\x00\x33\x00\x87\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\x3a\x00\x22\x00\xbb\x00\xbc\x00\x8c\x00\xbe\x00\xd5\x00\x96\x00\xbb\x00\x98\x00\x22\x00\xba\x00\x90\x00\x6a\x00\x92\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xc8\x00\xc9\x00\xca\x00\x39\x00\x21\x00\xc9\x00\x23\x00\xd5\x00\x25\x00\x26\x00\x27\x00\x28\x00\x39\x00\xb3\x00\xb4\x00\x2c\x00\x43\x00\x2e\x00\x2f\x00\x22\x00\x47\x00\xbb\x00\x49\x00\x4a\x00\x4b\x00\x28\x00\x21\x00\xc9\x00\x23\x00\x6f\x00\xcc\x00\xcd\x00\x27\x00\x28\x00\xc8\x00\xc9\x00\xca\x00\x2c\x00\xb9\x00\x2e\x00\x2f\x00\x29\x00\xbd\x00\x5b\x00\x5c\x00\xdb\x00\xdc\x00\xbb\x00\xb9\x00\x05\x00\x06\x00\x03\x00\x26\x00\x6f\x00\xc9\x00\xca\x00\x08\x00\x09\x00\xcd\x00\x2d\x00\xc8\x00\xc9\x00\xca\x00\xb4\x00\xc9\x00\xca\x00\x16\x00\x43\x00\x44\x00\x45\x00\xbb\x00\x47\x00\x1c\x00\x49\x00\x4a\x00\x4b\x00\x08\x00\xb7\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\xbc\x00\xc8\x00\xc9\x00\xca\x00\x22\x00\x90\x00\x5d\x00\x92\x00\x26\x00\x42\x00\x43\x00\x7a\x00\x45\x00\x2b\x00\x47\x00\xcb\x00\x49\x00\x4a\x00\x4b\x00\x82\x00\x83\x00\x84\x00\x85\x00\x25\x00\x6f\x00\x88\x00\x89\x00\x8a\x00\x17\x00\x17\x00\x8d\x00\x8e\x00\x8f\x00\x7a\x00\x54\x00\x31\x00\x32\x00\x33\x00\x58\x00\x96\x00\x22\x00\x82\x00\x83\x00\x84\x00\x85\x00\x28\x00\xc9\x00\x88\x00\x89\x00\x8a\x00\x3f\x00\x40\x00\x8d\x00\x8e\x00\x8f\x00\xd0\x00\x21\x00\xd2\x00\x23\x00\xd4\x00\xbe\x00\x96\x00\x27\x00\x28\x00\xdb\x00\xdc\x00\xc9\x00\x2c\x00\xc9\x00\x2e\x00\x2f\x00\xcc\x00\xcd\x00\xb8\x00\xcc\x00\xcd\x00\xbb\x00\xbc\x00\xc9\x00\xbe\x00\x90\x00\xcc\x00\xcd\x00\x93\x00\xdb\x00\xdc\x00\xdb\x00\xdc\x00\x59\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xdb\x00\xdc\x00\xbb\x00\xbc\x00\x5d\x00\xbe\x00\xd5\x00\x05\x00\x06\x00\x54\x00\xbc\x00\x90\x00\x57\x00\x58\x00\x93\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x5d\x00\x6f\x00\xc9\x00\x16\x00\xcb\x00\xcc\x00\xcd\x00\xd5\x00\x42\x00\x43\x00\x49\x00\x4a\x00\x4b\x00\x47\x00\xbc\x00\x49\x00\x4a\x00\x4b\x00\x6f\x00\x22\x00\xdb\x00\xdc\x00\x22\x00\x19\x00\x08\x00\x28\x00\x0a\x00\xc9\x00\x7a\x00\xcb\x00\xcc\x00\xcd\x00\x22\x00\x2d\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\x85\x00\xc9\x00\xca\x00\x88\x00\x89\x00\x8a\x00\xdb\x00\xdc\x00\x8d\x00\x8e\x00\x8f\x00\x21\x00\x16\x00\x23\x00\x25\x00\xcf\x00\xb9\x00\x96\x00\xd2\x00\x17\x00\xbd\x00\x69\x00\x2c\x00\x17\x00\x2e\x00\x2f\x00\x31\x00\x32\x00\x33\x00\xbb\x00\x22\x00\x19\x00\xc9\x00\xca\x00\x22\x00\x21\x00\xcd\x00\x23\x00\xd8\x00\x90\x00\x22\x00\x92\x00\xc8\x00\xc9\x00\xca\x00\x2b\x00\x2c\x00\xbf\x00\x2e\x00\x2f\x00\xc2\x00\xb8\x00\xc4\x00\x17\x00\xbb\x00\xbc\x00\x19\x00\xbe\x00\x1a\x00\x1b\x00\x1c\x00\x18\x00\x17\x00\xcf\x00\x22\x00\x22\x00\xd2\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x22\x00\x42\x00\x43\x00\xbb\x00\x0d\x00\x0e\x00\x47\x00\xd5\x00\x49\x00\x4a\x00\x4b\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xad\x00\xc8\x00\xc9\x00\xca\x00\x72\x00\x73\x00\x74\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xc9\x00\x7a\x00\xd7\x00\xcc\x00\xcd\x00\xc9\x00\x33\x00\x7b\x00\xcc\x00\xcd\x00\x2b\x00\x84\x00\x2d\x00\x24\x00\x25\x00\x88\x00\x27\x00\x8a\x00\xdb\x00\xdc\x00\x8d\x00\x8e\x00\x8f\x00\xdb\x00\xdc\x00\x7a\x00\x31\x00\x32\x00\x33\x00\x96\x00\x22\x00\x17\x00\x0d\x00\x0e\x00\x19\x00\x84\x00\x21\x00\x29\x00\x23\x00\x88\x00\xcd\x00\x8a\x00\x22\x00\x22\x00\x8d\x00\x8e\x00\x8f\x00\x2c\x00\x43\x00\x2e\x00\x2f\x00\xd7\x00\x47\x00\x96\x00\x49\x00\x4a\x00\x4b\x00\x66\x00\x67\x00\x19\x00\x21\x00\x1e\x00\x23\x00\xb8\x00\xd8\x00\x22\x00\xbb\x00\xbc\x00\x22\x00\xbe\x00\x01\x00\x2c\x00\x1e\x00\x2e\x00\x2f\x00\x11\x00\x22\x00\x08\x00\x09\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb6\x00\xb7\x00\xb8\x00\xc7\x00\x17\x00\xbb\x00\xbc\x00\xd5\x00\xbe\x00\x97\x00\xce\x00\xcf\x00\xd0\x00\x27\x00\xd2\x00\x29\x00\xd4\x00\x16\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x27\x00\xc9\x00\x29\x00\xd2\x00\xcc\x00\xcd\x00\x01\x00\xd5\x00\xbb\x00\x73\x00\x74\x00\xb9\x00\xd7\x00\x08\x00\x09\x00\xbd\x00\x7a\x00\x6d\x00\x6e\x00\xdb\x00\xdc\x00\xc8\x00\xc9\x00\xca\x00\x0d\x00\x0e\x00\x84\x00\xc9\x00\xca\x00\x69\x00\x88\x00\xcd\x00\x8a\x00\xbb\x00\x28\x00\x8d\x00\x8e\x00\x8f\x00\xc9\x00\xca\x00\x7a\x00\x2f\x00\xcd\x00\x27\x00\x96\x00\x29\x00\xc8\x00\xc9\x00\xca\x00\xbb\x00\x84\x00\x27\x00\xbe\x00\x29\x00\x88\x00\x86\x00\x8a\x00\xbb\x00\x28\x00\x8d\x00\x8e\x00\x8f\x00\xc8\x00\xc9\x00\xca\x00\x2f\x00\xcc\x00\xcd\x00\x96\x00\xd7\x00\xc8\x00\xc9\x00\xca\x00\xc9\x00\x0d\x00\x0e\x00\xcc\x00\xcd\x00\xb8\x00\x54\x00\x55\x00\xbb\x00\xbc\x00\x97\x00\xbe\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x59\x00\xdb\x00\xdc\x00\x4d\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xd6\x00\x27\x00\xb8\x00\x29\x00\x69\x00\xbb\x00\xbc\x00\xd5\x00\xbe\x00\x51\x00\x52\x00\x53\x00\x54\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x52\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x5f\x00\x60\x00\x84\x00\x99\x00\x9a\x00\x9b\x00\x88\x00\xd5\x00\x8a\x00\x6d\x00\x6e\x00\x8d\x00\x8e\x00\x8f\x00\x78\x00\x79\x00\x7a\x00\x99\x00\x9a\x00\x9b\x00\x96\x00\x43\x00\x30\x00\x31\x00\x69\x00\x47\x00\x84\x00\x49\x00\x4a\x00\x4b\x00\x88\x00\x27\x00\x8a\x00\x29\x00\xd2\x00\x8d\x00\x8e\x00\x8f\x00\xab\x00\xac\x00\xad\x00\x43\x00\xd6\x00\x45\x00\x96\x00\x47\x00\x03\x00\x49\x00\x4a\x00\x4b\x00\x0f\x00\x10\x00\x4e\x00\x4f\x00\xb8\x00\x0d\x00\x0e\x00\xbb\x00\xbc\x00\xd7\x00\xbe\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x6c\x00\x6d\x00\x6e\x00\x0d\x00\x0e\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x9c\x00\x27\x00\xb8\x00\x29\x00\x0a\x00\xbb\x00\xbc\x00\xd5\x00\xbe\x00\x30\x00\x31\x00\x3e\x00\x3f\x00\x40\x00\x38\x00\x0c\x00\x0d\x00\x0e\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x43\x00\x3a\x00\x45\x00\xd5\x00\x47\x00\x6f\x00\x49\x00\x4a\x00\x4b\x00\x30\x00\x31\x00\x4e\x00\x4f\x00\x0c\x00\x0d\x00\x0e\x00\x42\x00\x43\x00\x6c\x00\x6d\x00\x6e\x00\x47\x00\xd6\x00\x49\x00\x4a\x00\x4b\x00\xd7\x00\x27\x00\x43\x00\x29\x00\x45\x00\x29\x00\x47\x00\x2b\x00\x49\x00\x4a\x00\x4b\x00\x42\x00\x43\x00\x4e\x00\x4f\x00\x27\x00\x47\x00\x29\x00\x49\x00\x4a\x00\x4b\x00\xd7\x00\xc8\x00\xc9\x00\xca\x00\xc9\x00\xcc\x00\xcd\x00\xcc\x00\xcd\x00\x9a\x00\x9b\x00\xbc\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5e\x00\x5f\x00\x60\x00\xdb\x00\xdc\x00\xc9\x00\x70\x00\xcb\x00\xcc\x00\xcd\x00\x6c\x00\x6d\x00\x6e\x00\x35\x00\x43\x00\xb9\x00\x45\x00\x7f\x00\x47\x00\xbd\x00\x49\x00\x4a\x00\x4b\x00\xdb\x00\xdc\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x0d\x00\x0e\x00\xc9\x00\xca\x00\x0d\x00\x0e\x00\xcd\x00\x7d\x00\x7e\x00\x7f\x00\x43\x00\xb9\x00\x45\x00\x6f\x00\x47\x00\xbd\x00\x49\x00\x4a\x00\x4b\x00\x0d\x00\x0e\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x59\x00\xbc\x00\xc9\x00\xca\x00\x69\x00\xc9\x00\xcd\x00\x7b\x00\xcc\x00\xcd\x00\x7b\x00\x40\x00\x41\x00\x27\x00\xc9\x00\x29\x00\xcb\x00\xcc\x00\xcd\x00\x7d\x00\x7e\x00\x7f\x00\xd7\x00\xdb\x00\xdc\x00\x99\x00\x9a\x00\x9b\x00\x27\x00\xbc\x00\x29\x00\xc9\x00\xdb\x00\xdc\x00\xcc\x00\xcd\x00\x27\x00\x90\x00\x29\x00\x99\x00\x9a\x00\x9b\x00\xc9\x00\xb1\x00\xcb\x00\xcc\x00\xcd\x00\x05\x00\x06\x00\xdb\x00\xdc\x00\x27\x00\xc9\x00\x29\x00\xd7\x00\xcc\x00\xcd\x00\x88\x00\x89\x00\x8a\x00\xdb\x00\xdc\x00\x90\x00\x90\x00\x46\x00\x47\x00\x9c\x00\x49\x00\x4a\x00\x4b\x00\xdb\x00\xdc\x00\x43\x00\x27\x00\x45\x00\x29\x00\x47\x00\xd7\x00\x49\x00\x4a\x00\x4b\x00\xbc\x00\x4d\x00\x4e\x00\x4f\x00\xc8\x00\xc9\x00\xca\x00\x86\x00\xcc\x00\xcd\x00\x27\x00\xc7\x00\x29\x00\xc9\x00\x65\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x27\x00\xd2\x00\x29\x00\xd4\x00\xbc\x00\x34\x00\x27\x00\x68\x00\x29\x00\x34\x00\xdb\x00\xdc\x00\x2b\x00\x56\x00\x2d\x00\xc7\x00\x29\x00\xc9\x00\x2b\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\x75\x00\xd2\x00\xcd\x00\xd4\x00\x39\x00\xb9\x00\x08\x00\x09\x00\x39\x00\xbd\x00\xdb\x00\xdc\x00\x43\x00\x22\x00\x45\x00\xd8\x00\x47\x00\x39\x00\x49\x00\x4a\x00\x4b\x00\xc9\x00\xca\x00\x4e\x00\x4f\x00\xcd\x00\x51\x00\x47\x00\x39\x00\x49\x00\x4a\x00\x4b\x00\x43\x00\x39\x00\x45\x00\x52\x00\x47\x00\x97\x00\x49\x00\x4a\x00\x4b\x00\x37\x00\x38\x00\x4e\x00\x4f\x00\xd6\x00\x51\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x6a\x00\x43\x00\x17\x00\x45\x00\x17\x00\x47\x00\x16\x00\x49\x00\x4a\x00\x4b\x00\x22\x00\x4d\x00\x4e\x00\x4f\x00\x17\x00\xbc\x00\x16\x00\xc9\x00\x05\x00\x06\x00\xcc\x00\xcd\x00\x05\x00\x06\x00\x32\x00\x25\x00\x4a\x00\x27\x00\xc9\x00\x5c\x00\xcb\x00\xcc\x00\xcd\x00\x28\x00\x29\x00\xdb\x00\xdc\x00\x31\x00\x32\x00\x33\x00\x05\x00\x06\x00\x4a\x00\x4b\x00\x03\x00\x04\x00\xdb\x00\xdc\x00\x0c\x00\x43\x00\x8b\x00\x45\x00\x62\x00\x47\x00\x8b\x00\x49\x00\x4a\x00\x4b\x00\x90\x00\x4d\x00\x4e\x00\x4f\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x4a\x00\x4b\x00\x1c\x00\x43\x00\x4a\x00\x45\x00\x28\x00\x47\x00\x29\x00\x49\x00\x4a\x00\x4b\x00\x29\x00\x4d\x00\x4e\x00\x4f\x00\xbc\x00\x85\x00\x86\x00\x28\x00\x29\x00\x7a\x00\x22\x00\x17\x00\x24\x00\x25\x00\x17\x00\x27\x00\x28\x00\xc9\x00\x62\x00\xcb\x00\xcc\x00\xcd\x00\x05\x00\x06\x00\xbc\x00\x31\x00\x32\x00\x33\x00\xc9\x00\x0f\x00\x17\x00\xcc\x00\xcd\x00\x1c\x00\x29\x00\xdb\x00\xdc\x00\xc9\x00\x1d\x00\xcb\x00\xcc\x00\xcd\x00\x32\x00\x28\x00\xbc\x00\x27\x00\xdb\x00\xdc\x00\x32\x00\x1c\x00\x7a\x00\x2b\x00\x47\x00\x79\x00\x22\x00\xdb\x00\xdc\x00\xc9\x00\x0c\x00\xcb\x00\xcc\x00\xcd\x00\x43\x00\x17\x00\x45\x00\x64\x00\x47\x00\x17\x00\x49\x00\x4a\x00\x4b\x00\x22\x00\x4d\x00\x4e\x00\x4f\x00\xdb\x00\xdc\x00\x1e\x00\x05\x00\x8b\x00\x8b\x00\x17\x00\x32\x00\x43\x00\x1e\x00\x45\x00\x29\x00\x47\x00\x28\x00\x49\x00\x4a\x00\x4b\x00\xbc\x00\x4d\x00\x4e\x00\x4f\x00\x22\x00\x16\x00\x1c\x00\xc0\x00\x17\x00\x7b\x00\xc3\x00\x8b\x00\xc5\x00\xc9\x00\xc7\x00\xcb\x00\xcc\x00\xcd\x00\x4a\x00\x4b\x00\xbc\x00\xce\x00\xcf\x00\xd0\x00\x7a\x00\xd2\x00\x80\x00\xd4\x00\x29\x00\x8b\x00\x8b\x00\xdb\x00\xdc\x00\xc9\x00\x25\x00\xcb\x00\xcc\x00\xcd\x00\x43\x00\x22\x00\x45\x00\x1c\x00\x47\x00\x8b\x00\x49\x00\x4a\x00\x4b\x00\x8b\x00\x4d\x00\x4e\x00\x4f\x00\xdb\x00\xdc\x00\x47\x00\x1e\x00\x49\x00\x4a\x00\x4b\x00\x43\x00\x28\x00\x45\x00\x17\x00\x47\x00\x66\x00\x49\x00\x4a\x00\x4b\x00\x6b\x00\x4d\x00\x4e\x00\x4f\x00\x8b\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x1d\x00\x1d\x00\x43\x00\x17\x00\x45\x00\x31\x00\x47\x00\x1c\x00\x49\x00\x4a\x00\x4b\x00\x17\x00\x4d\x00\x4e\x00\x4f\x00\xbc\x00\x62\x00\x5d\x00\x05\x00\x1e\x00\x2b\x00\x2b\x00\x22\x00\x41\x00\x1c\x00\x25\x00\x22\x00\x27\x00\xc9\x00\x4c\x00\xcb\x00\xcc\x00\xcd\x00\x2d\x00\x29\x00\x0c\x00\xbc\x00\x31\x00\x32\x00\x33\x00\x22\x00\x17\x00\x28\x00\x62\x00\x24\x00\x24\x00\xdb\x00\xdc\x00\x7a\x00\xc9\x00\x1d\x00\xcb\x00\xcc\x00\xcd\x00\x43\x00\x62\x00\x45\x00\x2d\x00\x47\x00\x2b\x00\x49\x00\x4a\x00\x4b\x00\x1d\x00\x4d\x00\x4e\x00\x4f\x00\xdb\x00\xdc\x00\xc9\x00\x2c\x00\x1d\x00\xcc\x00\xcd\x00\x43\x00\x28\x00\x45\x00\x1d\x00\x47\x00\x22\x00\x49\x00\x4a\x00\x4b\x00\xbc\x00\x4d\x00\x4e\x00\x4f\x00\xdb\x00\xdc\x00\x21\x00\x29\x00\x0f\x00\x16\x00\x0f\x00\x46\x00\x1e\x00\xc9\x00\x0f\x00\xcb\x00\xcc\x00\xcd\x00\x4c\x00\x17\x00\xbc\x00\x17\x00\x66\x00\x28\x00\xc9\x00\x0c\x00\x28\x00\xcc\x00\xcd\x00\x8b\x00\x21\x00\xdb\x00\xdc\x00\xc9\x00\x1e\x00\xcb\x00\xcc\x00\xcd\x00\x8b\x00\x8b\x00\xbc\x00\x28\x00\xdb\x00\xdc\x00\x29\x00\x1e\x00\x1d\x00\x17\x00\x22\x00\x28\x00\x7a\x00\xdb\x00\xdc\x00\xc9\x00\x7a\x00\xcb\x00\xcc\x00\xcd\x00\x43\x00\x2b\x00\x45\x00\x7a\x00\x47\x00\x24\x00\x49\x00\x4a\x00\x4b\x00\x7a\x00\x4d\x00\x4e\x00\x4f\x00\xdb\x00\xdc\x00\x66\x00\x62\x00\x22\x00\x24\x00\x27\x00\x43\x00\x1c\x00\x45\x00\x1d\x00\x47\x00\x1e\x00\x49\x00\x4a\x00\x4b\x00\x77\x00\x4d\x00\x4e\x00\x4f\x00\x47\x00\xbc\x00\x17\x00\x24\x00\x24\x00\x1b\x00\x29\x00\x22\x00\xc0\x00\x8b\x00\x05\x00\xc3\x00\x1c\x00\xc5\x00\xc9\x00\xc7\x00\xcb\x00\xcc\x00\xcd\x00\x17\x00\x17\x00\xbc\x00\xce\x00\xcf\x00\xd0\x00\x17\x00\xd2\x00\x7c\x00\xd4\x00\x17\x00\x17\x00\x17\x00\xdb\x00\xdc\x00\xc9\x00\x22\x00\xcb\x00\xcc\x00\xcd\x00\x43\x00\x17\x00\x45\x00\x17\x00\x47\x00\x21\x00\x49\x00\x4a\x00\x4b\x00\x2d\x00\x4d\x00\x4e\x00\x4f\x00\xdb\x00\xdc\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x2b\x00\x43\x00\x17\x00\x45\x00\x21\x00\x47\x00\x41\x00\x49\x00\x4a\x00\x4b\x00\x74\x00\x4d\x00\x4e\x00\x4f\x00\x27\x00\x1c\x00\x41\x00\x41\x00\x4c\x00\x6b\x00\x8b\x00\x43\x00\x2d\x00\x45\x00\x64\x00\x47\x00\x8b\x00\x49\x00\x4a\x00\x4b\x00\xbc\x00\x0c\x00\x4e\x00\x4f\x00\x17\x00\x17\x00\x17\x00\xc0\x00\x22\x00\x17\x00\xc3\x00\x21\x00\xc5\x00\xc9\x00\xc7\x00\xcb\x00\xcc\x00\xcd\x00\x2b\x00\x7a\x00\xbc\x00\xce\x00\xcf\x00\xd0\x00\x20\x00\xd2\x00\x29\x00\xd4\x00\x22\x00\x0f\x00\x05\x00\xdb\x00\xdc\x00\xc9\x00\x8b\x00\xcb\x00\xcc\x00\xcd\x00\x43\x00\x6b\x00\x45\x00\x1d\x00\x47\x00\x8c\x00\x49\x00\x4a\x00\x4b\x00\x72\x00\x0f\x00\x4e\x00\x4f\x00\xdb\x00\xdc\x00\x20\x00\x6f\x00\x1d\x00\x16\x00\x65\x00\x43\x00\x0c\x00\x45\x00\x0f\x00\x47\x00\x28\x00\x49\x00\x4a\x00\x4b\x00\x0f\x00\x8c\x00\x4e\x00\x4f\x00\x0f\x00\xbc\x00\x1d\x00\x8c\x00\x8c\x00\x2c\x00\x1d\x00\x1d\x00\x1d\x00\x2c\x00\x00\x00\x8c\x00\x72\x00\xff\xff\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xbc\x00\xff\xff\xff\xff\xc9\x00\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xbc\x00\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x4f\x00\xdb\x00\xdc\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xbc\x00\xff\xff\x4e\x00\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xbc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x4f\x00\xdb\x00\xdc\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\x96\x00\x49\x00\x4a\x00\x4b\x00\x50\x00\xff\xff\x4e\x00\x4f\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x43\x00\x5c\x00\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x4f\x00\x68\x00\xbc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\x7b\x00\xff\xff\xbc\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xc9\x00\xd5\x00\xcb\x00\xcc\x00\xcd\x00\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x4f\x00\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xbc\x00\xff\xff\x4e\x00\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xbc\x00\x43\x00\x44\x00\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\x43\x00\xff\xff\xbc\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x4f\x00\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x4f\x00\xff\xff\xbc\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\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\x43\x00\xbc\x00\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\x43\x00\xff\xff\x45\x00\xff\xff\x47\x00\xff\xff\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\xbc\x00\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\x4a\x00\x4b\x00\x4c\x00\xff\xff\xc9\x00\xdb\x00\xdc\x00\xcc\x00\xcd\x00\x46\x00\x47\x00\xbc\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\x46\x00\x47\x00\xbc\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\x61\x00\x62\x00\x63\x00\xff\xff\x65\x00\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\x61\x00\x62\x00\x63\x00\xff\xff\x65\x00\xff\xff\xdb\x00\xdc\x00\xbc\x00\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xbc\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xcb\x00\xcc\x00\xcd\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xc7\x00\xff\xff\xc9\x00\xff\xff\xbe\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc9\x00\xff\xff\xff\xff\xcc\x00\xcd\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xc9\x00\xff\xff\xff\xff\xcc\x00\xcd\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\xdb\x00\xdc\x00\xc9\x00\xff\xff\xff\xff\xcc\x00\xcd\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\xc9\x00\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xc9\x00\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc9\x00\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xc9\x00\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc9\x00\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xc9\x00\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xdb\x00\xdc\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x7c\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\x8a\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xc0\x00\x18\x00\xff\xff\xc3\x00\xff\xff\xc5\x00\xff\xff\xc7\x00\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x2a\x00\xd4\x00\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\x8a\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x01\x00\x73\x00\xff\xff\x75\x00\x05\x00\x06\x00\x78\x00\xff\xff\x09\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x16\x00\xff\xff\x18\x00\x8a\x00\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\x20\x00\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x16\x00\x5c\x00\x18\x00\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\x20\x00\xff\xff\x09\x00\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x16\x00\x5c\x00\x18\x00\x32\x00\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x68\x00\x24\x00\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\xff\xff\x7b\x00\x50\x00\x51\x00\x52\x00\x53\x00\x0f\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x16\x00\x5c\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\x66\x00\xff\xff\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x16\x00\x5c\x00\x18\x00\xff\xff\x01\x00\xff\xff\xff\xff\x7b\x00\x05\x00\x06\x00\x20\x00\xff\xff\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\x32\x00\xff\xff\xff\xff\xff\xff\x7b\x00\x50\x00\xff\xff\x20\x00\xff\xff\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x87\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\xff\xff\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\x7b\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x16\x00\x5c\x00\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x68\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\x24\x00\x25\x00\x87\x00\x27\x00\x28\x00\x29\x00\xff\xff\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x68\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\xff\xff\x18\x00\x19\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\x23\x00\x24\x00\x25\x00\x87\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\x23\x00\x24\x00\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\x23\x00\x24\x00\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\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\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\x23\x00\x24\x00\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\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\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\x23\x00\x24\x00\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\x23\x00\x24\x00\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\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\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\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\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\x77\x00\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x82\x00\x83\x00\x84\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\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\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\x60\x00\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\x71\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\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\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\x60\x00\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\x71\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\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\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\x60\x00\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\x96\x00\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xb8\x00\x18\x00\xff\xff\xbb\x00\xbc\x00\x1c\x00\xbe\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x88\x00\x5c\x00\x8a\x00\x5e\x00\xff\xff\x8d\x00\x8e\x00\x8f\x00\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x96\x00\xff\xff\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\x71\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xb8\x00\x18\x00\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\x60\x00\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\xff\xff\x96\x00\xff\xff\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x2f\x00\xff\xff\x31\x00\x32\x00\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\x71\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\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\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\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\xff\xff\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x96\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\x7b\x00\xbe\x00\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x2f\x00\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x96\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\x7b\x00\xbe\x00\x20\x00\x01\x00\xff\xff\x23\x00\xff\xff\x05\x00\xff\xff\x07\x00\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\x38\x00\xff\xff\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x42\x00\x43\x00\x44\x00\xff\xff\x46\x00\xff\xff\x48\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x7b\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\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x16\x00\x17\x00\x18\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\x24\x00\x25\x00\xb8\x00\x27\x00\x28\x00\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xd5\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x01\x00\x5c\x00\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\x08\x00\x09\x00\xff\xff\x0b\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x16\x00\xff\xff\x18\x00\x05\x00\x06\x00\xff\xff\x08\x00\x09\x00\xff\xff\x0b\x00\x20\x00\x7b\x00\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\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\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\x50\x00\x51\x00\x52\x00\x53\x00\x68\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x68\x00\x20\x00\x01\x00\x22\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\x16\x00\x17\x00\x18\x00\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\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\x20\x00\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x01\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x7b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\x68\x00\x16\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x7b\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x16\x00\x5c\x00\x18\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\x05\x00\x06\x00\x20\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x50\x00\x51\x00\x52\x00\x53\x00\x22\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\x65\x00\x66\x00\xff\xff\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x16\x00\x5c\x00\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\x20\x00\x66\x00\xff\xff\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\x72\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\x68\x00\xff\xff\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x20\x00\x21\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x01\x00\x02\x00\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x50\x00\x51\x00\x52\x00\x53\x00\x7b\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x68\x00\x5c\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x7b\x00\x5c\x00\xff\xff\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\x72\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x20\x00\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x7b\x00\x5c\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x68\x00\x5c\x00\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x6f\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x16\x00\xff\xff\x18\x00\x05\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x20\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x65\x00\x66\x00\xff\xff\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x7b\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x01\x00\x02\x00\x50\x00\x51\x00\x52\x00\x53\x00\x68\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x65\x00\x66\x00\x7b\x00\x68\x00\x01\x00\xff\xff\x1e\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x26\x00\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\x16\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\x68\x00\x05\x00\x06\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x16\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x65\x00\x66\x00\x05\x00\x68\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x16\x00\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\x1e\x00\x68\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x01\x00\xff\xff\xff\xff\x7b\x00\x05\x00\x06\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x20\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x01\x00\x5c\x00\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x7b\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x16\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\x68\x00\xff\xff\xff\xff\x26\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x7b\x00\x50\x00\x51\x00\x52\x00\x53\x00\x20\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\x65\x00\x66\x00\x20\x00\x68\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\x68\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\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x7b\x00\x50\x00\x51\x00\x52\x00\x53\x00\x20\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x16\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x68\x00\x5c\x00\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x7b\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x16\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\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\x16\x00\x50\x00\x51\x00\x52\x00\x53\x00\x7b\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x7b\x00\x5c\x00\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x65\x00\x66\x00\x05\x00\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x01\x00\xff\xff\x65\x00\x66\x00\xff\xff\x68\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\x7b\x00\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x01\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x16\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x25\x00\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\x68\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x16\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x7b\x00\x5c\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x01\x00\xff\xff\x68\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\x24\x00\x25\x00\x7b\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x68\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x7b\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x68\x00\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xff\xff\xa6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa2\x00\xa3\x00\xa4\x00\xff\xff\xa6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xa3\x00\xa4\x00\xff\xff\xa6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xa5\x00\xa6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xae\x00\xff\xff\xb0\x00\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xa5\x00\xa6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xae\x00\xff\xff\xb0\x00\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xa5\x00\xa6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xae\x00\xff\xff\xb0\x00\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xae\x00\xff\xff\xb0\x00\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\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\xa6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\x96\x00\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xd5\x00\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xd5\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xd5\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xd5\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xd5\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xd5\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xd5\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xd5\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\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\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9f\x00\xa0\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xd1\x00\xff\xff\xd3\x00\xd4\x00\xd5\x00\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xd1\x00\xff\xff\xd3\x00\xd4\x00\xd5\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xd1\x00\xff\xff\xd3\x00\xd4\x00\xd5\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xd1\x00\xff\xff\xd3\x00\xd4\x00\xd5\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xd1\x00\xff\xff\xd3\x00\xd4\x00\xd5\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xd1\x00\xff\xff\xd3\x00\xd4\x00\xd5\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xd1\x00\xff\xff\xd3\x00\xd4\x00\xd5\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xc1\x00\xff\xff\xc3\x00\xff\xff\xff\xff\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xff\xff\xd1\x00\xff\xff\xd3\x00\xd4\x00\xd5\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xa9\x00\xaa\x00\xff\xff\x96\x00\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xaa\x00\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\x85\x00\xbe\x00\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x96\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xd5\x00\x88\x00\x89\x00\x8a\x00\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\x96\x00\xff\xff\xff\xff\x99\x00\x9a\x00\x9b\x00\xff\xff\x9d\x00\x9e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\x99\x00\x9a\x00\x9b\x00\xff\xff\x9d\x00\x9e\x00\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb8\x00\xff\xff\xff\xff\xbb\x00\xbc\x00\xff\xff\xbe\x00\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd5\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"# happyTable :: HappyAddr happyTable = HappyA# "\x00\x00\x0c\x00\x09\x00\x0b\x00\x9d\x00\x09\x00\x9e\x00\x45\x02\x65\x03\x66\x03\x67\x03\x72\x03\x4e\x03\xf6\x02\x53\x04\x42\x04\xf8\x01\x35\x03\x8f\x01\x0b\x03\xc0\x00\x18\x03\x8d\x01\x4d\x03\x4e\x03\x31\x03\x54\x04\x55\x04\xf1\x00\x8f\x01\x21\x02\x6e\x02\xc0\x00\xba\xff\xc0\x00\x6e\x02\xff\x03\x34\x03\xb3\x02\xc1\x00\x8f\x01\x21\x02\xc2\x01\x8f\x01\x89\x03\x8f\x01\x0b\x03\x77\x02\x8f\x01\xa5\x03\x8f\x01\x3e\x03\x8f\x01\x3e\x03\xb8\x00\xc0\x00\xd3\x01\xd8\x00\x22\x02\xda\x00\x0c\x01\x6f\x00\x5a\x04\x05\x01\x34\x02\x0b\x01\x36\x02\xba\x03\x97\x03\x24\x02\xd7\x00\xd8\x00\x36\x02\x8f\x01\xa5\x03\x0e\x01\xd0\x01\x94\x01\xd1\x01\xe8\x03\x72\x00\xfc\x01\xa3\x00\xf2\x00\xa4\x00\xb4\x02\x0b\x03\xde\x00\xd7\x00\xd8\x00\xd1\x00\xd2\x00\xf3\x00\x30\x02\xd4\x00\xbb\x03\xd5\x00\xd4\x01\x4a\x00\xdd\x00\x4b\x00\x4c\x00\x06\x01\x5d\x04\x06\x01\xd5\x01\x8f\x01\x89\x03\x95\x01\x5f\x04\x02\x04\xe0\x00\xe1\x00\xe2\x00\x06\x01\x51\x04\xff\x01\xdd\x00\x19\x03\x25\x00\xc0\x03\x5a\x03\x5b\x03\x01\x04\x02\x04\xa6\x03\xa5\x00\x4c\x04\x31\x02\xe0\x00\xe1\x00\xe2\x00\xf4\x01\xba\x00\x7a\x00\xd0\x01\x7b\x00\xd1\x01\x5c\x03\xc9\x01\xca\x01\x7d\x00\xf6\x02\x8a\x03\xf7\x03\x7e\x00\xf2\x02\x7f\x00\x80\x00\x78\x02\xa7\x03\x11\x04\x12\x04\x21\x00\x4f\x03\x3f\x03\x7a\x00\x40\x03\x7b\x00\x29\x04\xf8\x03\xc9\x01\xca\x01\x7d\x00\x79\x02\x21\x00\x4f\x03\x7e\x00\x03\x04\x7f\x00\x80\x00\xf9\x01\x04\x04\x0c\x03\xfa\x01\x35\x02\xfb\x01\x37\x02\x68\x03\x78\x02\x06\x02\x69\x03\x56\x04\x3a\x02\x21\x00\xa9\x00\x57\x04\xfc\x01\xaa\x00\xc2\x00\xfd\x01\x20\x00\x21\x00\x22\x00\x79\x02\x24\x00\x25\x00\x23\x02\x21\x00\xa9\x00\x0d\x03\xc2\x00\xaa\x00\xc2\x00\x68\x03\x3f\x04\x8b\x03\x69\x03\x25\x02\x6a\x03\x46\x02\x8e\x01\x0a\x00\x0a\x00\x58\x04\x0a\x00\x0a\x00\x20\x00\x21\x00\x22\x00\x8e\x01\x24\x00\x25\x00\x81\x00\xc2\x00\xd8\x00\xd4\x03\xfd\x02\x68\x00\x69\x00\x6a\x00\x82\x00\x10\x00\x83\x00\x12\x00\x6a\x03\xee\x00\x13\x00\x14\x00\x15\x00\xd9\x03\xcb\x01\x16\x00\x17\x00\x18\x00\x81\x00\xa5\x00\x8c\x01\xd1\x00\xd2\x00\x6f\x00\x19\x00\x99\x03\x82\x00\x10\x00\x83\x00\x12\x00\xd0\x03\x56\x04\x13\x00\x14\x00\x15\x00\x57\x04\x03\x04\x16\x00\x17\x00\x18\x00\x04\x04\xf5\x01\x72\x00\x96\x02\x24\x00\x25\x00\x19\x00\x21\x00\xa9\x00\x79\x01\x03\x04\xaa\x00\x21\x00\xa9\x00\x04\x04\x43\x04\xaa\x00\xb2\x01\x1c\x00\xa5\x00\xfb\x02\x1d\x00\x1e\x00\x58\x04\x1f\x00\x31\x04\x21\x00\xa9\x00\xca\x00\x7a\x01\xaa\x00\x97\x02\x98\x02\xcf\x01\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x7b\x01\x03\x03\x1d\x00\x1e\x00\xf5\xff\x1f\x00\x26\x00\xd0\x01\x07\x02\xd1\x01\xc2\x01\x37\x03\xaa\x01\xcb\x00\xf9\x02\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x20\x00\x21\x00\x22\x00\x04\x03\x7a\x00\x79\x02\x7b\x00\x26\x00\xc8\x01\xc9\x01\xca\x01\x7d\x00\xc3\x01\x9c\x01\x9d\x01\x7e\x00\xe5\x01\x7f\x00\x80\x00\x8c\x02\xbd\x00\x9e\x01\x68\x00\x69\x00\x6a\x00\x17\x04\x7a\x00\x6f\x00\x7b\x00\x33\x04\x70\x00\x25\x00\x05\x03\x7d\x00\x20\x00\x21\x00\x22\x00\x7e\x00\xa7\x00\x7f\x00\x80\x00\x1a\x02\xa8\x00\xce\x03\xcf\x03\x71\x00\x72\x00\x07\x02\x2f\x03\x2c\x00\x2d\x00\x9f\x00\xfe\x02\x34\x04\x21\x00\xa9\x00\xa0\x00\xa1\x00\xaa\x00\xb2\x01\x20\x00\x21\x00\x22\x00\xf7\x02\x21\x00\xa9\x00\xd2\x03\x65\x00\x1b\x02\x1c\x02\x9e\x01\x67\x00\x6e\x02\x68\x00\x69\x00\x6a\x00\xd7\x00\x78\x03\xe9\x00\x6d\x00\x1d\x02\xf0\x00\x79\x03\x20\x00\x21\x00\x22\x00\xbd\x01\xaa\x01\x08\x04\xe8\x02\xbe\x01\x0d\x04\x0e\x04\x81\x00\x0f\x04\xbf\x01\xbd\x00\x23\x00\x68\x00\x69\x00\x6a\x00\x82\x00\x10\x00\x83\x00\x12\x00\xdd\x00\x09\x04\x13\x00\x14\x00\x15\x00\xef\x01\x64\x04\x16\x00\x17\x00\x18\x00\x81\x00\x72\x02\xe0\x00\xe1\x00\xe2\x00\x88\x03\x19\x00\x3d\x04\x82\x00\x10\x00\x83\x00\x12\x00\xf0\x01\x6f\x00\x13\x00\x14\x00\x15\x00\x53\x02\xb1\x00\x16\x00\x17\x00\x18\x00\x70\x01\x7a\x00\xd4\x00\x7b\x00\xd5\x00\xd0\x03\x19\x00\x7c\x00\x7d\x00\x3c\x03\x72\x00\x6f\x00\x7e\x00\x6f\x00\x7f\x00\x80\x00\x70\x00\x25\x00\x1c\x00\x24\x00\x25\x00\x1d\x00\x1e\x00\x6f\x00\x1f\x00\xb2\x01\xb8\x01\x25\x00\xe1\x02\xa2\x02\x72\x00\x71\x00\x72\x00\x37\x04\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\xe4\x01\x72\x00\x1d\x00\x1e\x00\x9c\x02\x1f\x00\x26\x00\x2c\x00\x2d\x00\x72\x02\x6e\x00\xb2\x01\x73\x02\x74\x02\xb3\x01\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x02\x9d\x02\x6f\x00\xd2\x03\x23\x00\x70\x00\x25\x00\x26\x00\xdf\x03\x27\x02\xf8\x00\x69\x00\x6a\x00\xbd\x00\x6e\x00\x68\x00\x69\x00\x6a\x00\x01\x02\x8c\x02\x71\x00\x72\x00\x03\x03\xe3\x02\xd7\x00\x8d\x02\xd9\x00\x6f\x00\x81\x00\x23\x00\x70\x00\x25\x00\xee\x00\x28\x04\x2c\x00\x2d\x00\x82\x00\x10\x00\x83\x00\x12\x00\x21\x00\x71\x03\x13\x00\x14\x00\x15\x00\x71\x00\x72\x00\x16\x00\x17\x00\x18\x00\x7a\x00\x1b\x03\x7b\x00\xdd\x00\x3c\x02\xa7\x00\x19\x00\x3d\x02\x3c\x04\xa8\x00\x38\x04\xe2\x03\xfb\x02\x7f\x00\x80\x00\xe0\x00\xe1\x00\xe2\x00\x2b\x02\x3d\x04\xb5\x01\x21\x00\xa9\x00\xee\x00\x7a\x00\xaa\x00\x7b\x00\x3e\x04\xaa\x01\xee\x00\xab\x01\x20\x00\x21\x00\x22\x00\x67\x02\x68\x02\xf9\x01\x7f\x00\x80\x00\xfa\x01\x1c\x00\x13\x03\xea\x02\x1d\x00\x1e\x00\xed\x00\x1f\x00\x4d\x04\x4e\x04\x4f\x04\xfc\x03\xad\x01\xfc\x01\xee\x00\xee\x00\xfd\x01\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xee\x00\xe9\x03\x27\x02\x2c\x02\x1a\x04\x1b\x04\xbd\x00\x26\x00\x68\x00\x69\x00\x6a\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\x21\x04\x20\x00\x21\x00\x22\x00\xe3\x03\xe4\x03\xe5\x03\xae\x00\xaf\x00\xb0\x00\xb1\x00\x6f\x00\x81\x00\xcc\x03\x70\x00\x25\x00\x6f\x00\xd9\x03\x22\x04\x70\x00\x25\x00\xc5\x03\x69\x02\xc6\x03\xdc\x00\xdd\x00\x13\x00\xde\x00\x15\x00\x71\x00\x72\x00\x16\x00\x17\x00\x18\x00\x71\x00\x72\x00\x81\x00\xe0\x00\xe1\x00\xe2\x00\x19\x00\x03\x03\xec\x01\xc6\x03\xc7\x03\xf1\x01\x69\x02\x7a\x00\x34\x03\x7b\x00\x13\x00\x9f\x02\x15\x00\xb0\x01\xb0\x01\x16\x00\x17\x00\x18\x00\xe2\x03\xe6\x01\x7f\x00\x80\x00\xe0\x03\xbd\x00\x19\x00\x68\x00\x69\x00\x6a\x00\xda\x03\xdb\x03\xf2\x01\x7a\x00\x15\x04\x7b\x00\x1c\x00\xf1\x03\x16\x04\x1d\x00\x1e\x00\xf3\x01\x1f\x00\x8b\x01\x77\x03\xef\x02\x7f\x00\x80\x00\xf3\x03\xf0\x02\x8a\x01\xa1\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x6a\x02\x6b\x02\x1c\x00\xcb\x01\xfa\x03\x1d\x00\x6c\x02\x26\x00\x1f\x00\xf6\x03\xd1\x00\xd2\x00\x70\x01\x2e\xfe\xd4\x00\x2e\xfe\xd5\x00\x5f\x03\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x40\xfe\x6f\x00\x40\xfe\x3d\x02\x70\x00\x25\x00\x89\x01\x26\x00\x2e\x02\x32\x04\xe5\x03\xa7\x00\x7b\x03\x8a\x01\xa1\x00\xa8\x00\x81\x00\xa3\x03\x94\x02\x71\x00\x72\x00\x20\x00\x21\x00\x22\x00\xeb\x03\xec\x03\x69\x02\x21\x00\xa9\x00\xab\x03\x13\x00\xaa\x00\x15\x00\x07\x02\x7d\x03\x16\x00\x17\x00\x18\x00\x21\x00\x9e\x02\x81\x00\x7e\x03\x9f\x02\x42\xfe\x19\x00\x42\xfe\x20\x00\x21\x00\x22\x00\x48\x01\x69\x02\x43\xfe\x49\x01\x43\xfe\x13\x00\xae\x03\x15\x00\x31\x02\x7d\x03\x16\x00\x17\x00\x18\x00\x20\x00\x21\x00\x22\x00\x7e\x03\x24\x00\x25\x00\x19\x00\xaf\x03\x20\x00\x21\x00\x22\x00\x6f\x00\x61\x03\x62\x03\x70\x00\x25\x00\x1c\x00\x86\x03\x87\x03\x1d\x00\x1e\x00\xb5\x03\x1f\x00\xd4\x01\x4a\x00\xff\x03\x4b\x00\x4c\x00\x16\x03\x71\x00\x72\x00\xd5\x01\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1b\x03\x4a\xfe\x1c\x00\x4a\xfe\x17\x03\x1d\x00\x1e\x00\x26\x00\x1f\x00\x7e\x02\x7f\x02\x80\x02\x81\x02\x7f\x03\x80\x03\x81\x03\x82\x03\x20\x03\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x91\x03\x90\x02\x83\x03\x26\x04\x13\x01\x14\x01\x13\x00\x26\x00\x15\x00\x1e\x03\x94\x02\x16\x00\x17\x00\x18\x00\x0a\x04\x81\x03\x82\x03\x3d\x04\x13\x01\x14\x01\x19\x00\xe7\x01\xee\x03\x49\x03\x1d\x03\xbd\x00\x83\x03\x68\x00\x69\x00\x6a\x00\x13\x00\x4b\xfe\x15\x00\x4b\xfe\x36\x03\x16\x00\x17\x00\x18\x00\xc1\x03\xc2\x03\xc3\x03\x65\x00\x39\x03\x66\x00\x19\x00\x67\x00\x57\x03\x68\x00\x69\x00\x6a\x00\x54\x03\x55\x03\x4a\x03\x6d\x00\x1c\x00\x42\x03\x43\x03\x1d\x00\x1e\x00\x59\x03\x1f\x00\xb2\x00\xaf\x00\xb0\x00\xb1\x00\xac\x03\x93\x02\x94\x02\x45\x03\x46\x03\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x4b\x02\x4c\xfe\x1c\x00\x4c\xfe\x4d\x02\x1d\x00\x1e\x00\x26\x00\x1f\x00\x48\x03\x49\x03\x54\x02\xb0\x00\xb1\x00\x55\x02\x48\x02\x8f\x01\x49\x02\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x52\x04\x94\x03\x69\x00\x6a\x00\x65\x00\x56\x02\x66\x00\x26\x00\x67\x00\x61\x02\x68\x00\x69\x00\x6a\x00\x4c\x03\x49\x03\x4a\x03\x6d\x00\x4a\x02\x8f\x01\x49\x02\x8c\x03\x27\x02\x92\x02\x93\x02\x94\x02\xbd\x00\x6e\x02\x68\x00\x69\x00\x6a\x00\x63\x02\x4d\xfe\x65\x00\x4d\xfe\x66\x00\xc7\xfe\x67\x00\xc7\xfe\x68\x00\x69\x00\x6a\x00\x26\x02\x27\x02\x4a\x03\x6d\x00\x4e\xfe\xbd\x00\x4e\xfe\x68\x00\x69\x00\x6a\x00\x64\x02\xb7\x01\x21\x00\x22\x00\x6f\x00\xb8\x01\x25\x00\x70\x00\x25\x00\xce\x02\x14\x01\x6e\x00\x10\x02\x11\x02\x12\x02\x13\x02\x14\x02\x15\x02\x16\x02\x8e\x02\x8f\x02\x90\x02\x71\x00\x72\x00\x6f\x00\x75\x02\x23\x00\x70\x00\x25\x00\xa4\x02\x93\x02\x94\x02\x7c\x02\x65\x00\xa7\x00\x66\x00\x89\x02\x67\x00\xa8\x00\x68\x00\x69\x00\x6a\x00\x71\x00\x72\x00\xee\x00\x6d\x00\xef\x00\xf0\x00\xcf\x02\xd0\x02\x21\x00\xa9\x00\x8f\x01\xf3\x02\xaa\x00\x08\x02\x09\x02\x0a\x02\x65\x00\xa7\x00\x66\x00\x71\x02\x67\x00\xa8\x00\x68\x00\x69\x00\x6a\x00\x8f\x01\x90\x01\xee\x00\x6d\x00\xef\x00\xf0\x00\x98\x02\x6e\x00\x21\x00\xa9\x00\x9a\x02\x6f\x00\xaa\x00\x81\x02\x70\x00\x25\x00\x8a\x02\xa5\x00\xa6\x00\x4f\xfe\x6f\x00\x4f\xfe\x23\x00\x70\x00\x25\x00\x0d\x02\x09\x02\x0a\x02\xab\x02\x71\x00\x72\x00\x44\x02\x13\x01\x14\x01\x50\xfe\x6e\x00\x50\xfe\x6f\x00\x71\x00\x72\x00\x70\x00\x25\x00\x51\xfe\xf1\x00\x51\xfe\x12\x01\x13\x01\x14\x01\x6f\x00\xad\x02\x23\x00\x70\x00\x25\x00\xf0\x02\x85\x01\x71\x00\x72\x00\x52\xfe\x6f\x00\x52\xfe\xd1\x02\x70\x00\x25\x00\x87\x01\x88\x01\x89\x01\x71\x00\x72\x00\xf1\x00\xeb\x00\x21\x03\xd7\x03\xcd\x01\x68\x00\x69\x00\x6a\x00\x71\x00\x72\x00\x65\x00\x53\xfe\x66\x00\x53\xfe\x67\x00\x92\x01\x68\x00\x69\x00\x6a\x00\x6e\x00\x2d\x04\x6c\x00\x6d\x00\x05\x02\x21\x00\x22\x00\xd6\x01\xb8\x01\x25\x00\x54\xfe\x95\x03\x54\xfe\x6f\x00\xd8\x03\x23\x00\x70\x00\x25\x00\xd1\x00\xd2\x00\xf3\x00\x5b\xfe\xd4\x00\x5b\xfe\xd5\x00\x6e\x00\x0e\x02\x5c\xfe\x2e\x04\x5c\xfe\x16\x02\x71\x00\x72\x00\xb1\x01\x17\x02\xb2\x01\xf2\x00\x0c\x02\x6f\x00\x0d\x02\x23\x00\x70\x00\x25\x00\xd1\x00\xd2\x00\xf3\x00\x1f\x02\xd4\x00\x3a\x02\xd5\x00\x32\x02\xa7\x00\x43\x02\xa1\x00\xb6\x00\xa8\x00\x71\x00\x72\x00\x65\x00\xe4\x00\x66\x00\x40\x02\x67\x00\xb8\x00\x68\x00\x69\x00\x6a\x00\x21\x00\xa9\x00\xe9\x00\x6d\x00\xaa\x00\xa8\x03\x60\x02\xba\x00\x68\x00\x69\x00\x6a\x00\x65\x00\xbb\x00\x66\x00\xe6\x00\x67\x00\x10\x01\x68\x00\x69\x00\x6a\x00\xb3\x00\xb4\x00\xe9\x00\x6d\x00\x4b\x01\xea\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xa9\x03\x65\x00\x63\x04\x66\x00\x5f\x04\x67\x00\x5a\x04\x68\x00\x69\x00\x6a\x00\x5c\x04\x44\x04\x6c\x00\x6d\x00\x5d\x04\x6e\x00\x52\x04\x6f\x00\x84\x01\x85\x01\x70\x00\x25\x00\x42\x02\x43\x02\x4c\x04\xdd\x00\x42\x04\xde\x00\x6f\x00\x41\x04\x23\x00\x70\x00\x25\x00\x03\x02\x04\x02\x71\x00\x72\x00\xe0\x00\xe1\x00\xe2\x00\x42\x02\x43\x02\x64\x03\x65\x03\x2a\x00\x2b\x00\x71\x00\x72\x00\x29\x04\x65\x00\x46\x04\x66\x00\x9c\x02\x67\x00\x48\x04\x68\x00\x69\x00\x6a\x00\xeb\x00\x2a\x04\x6c\x00\x6d\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\x07\x03\x08\x03\x6e\x02\x65\x00\x4a\x04\x66\x00\x03\x02\x67\x00\x49\xff\x68\x00\x69\x00\x6a\x00\x36\x04\x36\x04\x6c\x00\x6d\x00\x6e\x00\x4f\x02\x50\x02\x03\x02\x04\x02\x9a\x02\xdb\x00\x3a\x04\xdc\x00\xdd\x00\x3b\x04\xde\x00\xdf\x00\x6f\x00\x9c\x02\x23\x00\x70\x00\x25\x00\x42\x02\x43\x02\x6e\x00\xe0\x00\xe1\x00\xe2\x00\x6f\x00\xfe\x03\x01\x04\x70\x00\x25\x00\x6e\x02\x0d\x04\x71\x00\x72\x00\x6f\x00\xde\xfd\x23\x00\x70\x00\x25\x00\x18\x04\x1a\x04\x6e\x00\x1d\x04\x71\x00\x72\x00\x19\x04\x6e\x02\x83\x02\xc5\x03\x24\x04\x25\x04\x01\x03\x71\x00\x72\x00\x6f\x00\xca\x03\x23\x00\x70\x00\x25\x00\x65\x00\xcb\x03\x66\x00\xc9\x03\x67\x00\xcc\x03\x68\x00\x69\x00\x6a\x00\xf3\x01\x07\x04\x6c\x00\x6d\x00\x71\x00\x72\x00\xce\x03\x2c\x00\xd3\x03\xd6\x03\xde\x03\xdf\x03\x65\x00\xe2\x03\x66\x00\x42\x03\x67\x00\xf0\x03\x68\x00\x69\x00\x6a\x00\x6e\x00\x0b\x04\x6c\x00\x6d\x00\xf5\x03\xf3\x03\x6e\x02\xcd\x00\xf6\x03\xfc\x03\xce\x00\xfa\x03\xcf\x00\x6f\x00\xd0\x00\x23\x00\x70\x00\x25\x00\x43\x01\x6a\x00\x6e\x00\xd1\x00\xd2\x00\xd3\x00\x6e\x03\xd4\x00\x61\x03\xd5\x00\x71\x03\x6f\x03\x70\x03\x71\x00\x72\x00\x6f\x00\x74\x03\x23\x00\x70\x00\x25\x00\x65\x00\x76\x03\x66\x00\x6e\x02\x67\x00\x75\x03\x68\x00\x69\x00\x6a\x00\x77\x03\xed\x03\x6c\x00\x6d\x00\x71\x00\x72\x00\xe2\x01\x7d\x03\x68\x00\x69\x00\x6a\x00\x65\x00\x8e\x03\x66\x00\x8f\x03\x67\x00\x92\x02\x68\x00\x69\x00\x6a\x00\xd9\x01\x2e\x03\x6c\x00\x6d\x00\x93\x03\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdf\xfd\x97\x03\x65\x00\xa5\x03\x66\x00\xae\x03\x67\x00\xd8\x01\x68\x00\x69\x00\x6a\x00\xf5\x00\x47\x03\x6c\x00\x6d\x00\x6e\x00\x9c\x02\xbc\x03\x2c\x00\xb1\x03\xb1\x01\x02\x03\xee\x00\x05\x03\x6e\x02\xdd\x00\x01\x03\xde\x00\x6f\x00\x0a\x03\x23\x00\x70\x00\x25\x00\xf6\x00\x09\x03\x11\x03\x6e\x00\xe0\x00\xe1\x00\xe2\x00\x22\xff\x12\x03\x13\x03\x9c\x02\x15\x03\x16\x03\x71\x00\x72\x00\x9a\x02\x6f\x00\x1d\x03\x23\x00\x70\x00\x25\x00\x65\x00\x9c\x02\x66\x00\x20\x03\x67\x00\x2e\x03\x68\x00\x69\x00\x6a\x00\xc4\x00\x5f\x02\x6c\x00\x6d\x00\x71\x00\x72\x00\x6f\x00\x33\x03\xc4\x00\x70\x00\x25\x00\x65\x00\x39\x03\x66\x00\x3b\x03\x67\x00\x3c\x03\x68\x00\x69\x00\x6a\x00\x6e\x00\x99\x01\x6c\x00\x6d\x00\x44\x01\x72\x00\x4c\x03\x42\x03\x53\x03\x57\x03\x54\x03\xa3\x00\x5f\x03\x6f\x00\xb6\x00\x23\x00\x70\x00\x25\x00\x4d\x02\x51\x02\x6e\x00\x52\x02\x58\x02\x59\x02\x6f\x00\x5a\x02\x5c\x02\x70\x00\x25\x00\x5d\x02\x5b\x02\x71\x00\x72\x00\x6f\x00\x66\x02\x23\x00\x70\x00\x25\x00\x5e\x02\x5f\x02\x6e\x00\x03\x02\x71\x00\x72\x00\x63\x02\x67\x02\x70\x02\x71\x02\x27\xff\x03\x02\x77\x02\x71\x00\x72\x00\x6f\x00\x83\x02\x23\x00\x70\x00\x25\x00\x65\x00\x0d\x02\x66\x00\x83\x02\x67\x00\x8e\x02\x68\x00\x69\x00\x6a\x00\x9a\x02\xff\x01\x6c\x00\x6d\x00\x71\x00\x72\x00\x92\x02\x9c\x02\xa1\x02\xa7\x02\xa9\x02\x65\x00\xaf\x02\x66\x00\xb6\x02\x67\x00\xb0\x02\x68\x00\x69\x00\x6a\x00\xb3\x02\x04\x02\x6c\x00\x6d\x00\xb9\x02\x6e\x00\xa9\x01\xe0\x02\xe1\x02\xed\x02\xee\x02\xf3\x02\xcd\x00\xf5\x02\x2c\x00\xce\x00\x92\x01\x7e\x01\x6f\x00\xd0\x00\x23\x00\x70\x00\x25\x00\xa8\xfd\xaa\xfd\x6e\x00\xd1\x00\xd2\x00\xd3\x00\xa9\xfd\xd4\x00\xcc\x00\xd5\x00\xac\xfd\xaf\xfd\xa8\x01\x71\x00\x72\x00\x6f\x00\xbb\x01\x23\x00\x70\x00\x25\x00\x65\x00\xa9\x01\x66\x00\xaa\x01\x67\x00\xbc\x01\x68\x00\x69\x00\x6a\x00\xb2\x01\x4c\x01\x6c\x00\x6d\x00\x71\x00\x72\x00\x99\x03\x94\x03\x69\x00\x6a\x00\xc4\x01\x65\x00\xc5\x01\x66\x00\xe9\x00\x67\x00\xc6\x01\x68\x00\x69\x00\x6a\x00\xd6\x01\x6b\x00\x6c\x00\x6d\x00\xcd\x01\xd8\x01\xc7\x01\xc8\x01\xcf\x01\xd9\x01\xe0\x01\x65\x00\xdb\x01\x66\x00\x9a\x03\x67\x00\xe1\x01\x68\x00\x69\x00\x6a\x00\x6e\x00\xe2\x01\x10\x04\x6d\x00\xe9\x01\xea\x01\xeb\x01\xcd\x00\xed\x01\xee\x01\xce\x00\xf4\x01\x44\x03\x6f\x00\xd0\x00\x23\x00\x70\x00\x25\x00\x19\x02\x21\x02\x6e\x00\xd1\x00\xd2\x00\xd3\x00\xb8\x00\xd4\x00\x2b\x02\xd5\x00\x38\x02\x39\x02\x2c\x00\x71\x00\x72\x00\x6f\x00\x3f\x02\x23\x00\x70\x00\x25\x00\x65\x00\xd9\x01\x66\x00\x48\x02\x67\x00\xff\xff\x68\x00\x69\x00\x6a\x00\xa5\x00\xb6\x00\xa1\x02\x6d\x00\x71\x00\x72\x00\xb8\x00\xc6\x00\xc4\x00\xc7\x00\xc8\x00\x65\x00\xe6\x00\x66\x00\x03\x01\x67\x00\xf7\x00\x68\x00\x69\x00\x6a\x00\x04\x01\xff\xff\xa3\x02\x6d\x00\x05\x01\x6e\x00\x08\x01\xff\xff\xff\xff\x7c\x01\xc4\x00\x08\x01\x7d\x01\x04\xfe\xff\xff\xff\xff\xa5\x00\x00\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x00\x00\x6e\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x25\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x00\x00\x6e\x00\x71\x00\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x65\x00\x00\x00\x66\x00\x00\x00\x67\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\xa5\x02\x6d\x00\x71\x00\x72\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x65\x00\x00\x00\x66\x00\x00\x00\x67\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x6e\x00\x00\x00\xe3\x01\x6d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x02\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x00\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x65\x00\x00\x00\x66\x00\x00\x00\x67\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x19\x02\x6d\x00\x71\x00\x72\x00\xbf\x01\x09\x01\x17\x00\x18\x00\x00\x00\x65\x00\x00\x00\x66\x00\x00\x00\x67\x00\x19\x00\x68\x00\x69\x00\x6a\x00\x4d\x00\x00\x00\x1e\x02\x6d\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x65\x00\x57\x00\x66\x00\x00\x00\x67\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x2d\x02\x6d\x00\x5c\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x62\x00\x00\x00\x6e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x26\x00\x23\x00\x70\x00\x25\x00\x65\x00\x00\x00\x66\x00\x00\x00\x67\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\xc4\x00\x6d\x00\x71\x00\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x00\x00\x00\x66\x00\x00\x00\x67\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x6e\x00\x00\x00\xc8\x00\x6d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x00\x00\x6e\x00\x65\x00\xa5\x01\xa6\x01\x00\x00\xbd\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\xbc\x00\x00\x00\x6e\x00\x00\x00\xbd\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x65\x00\x00\x00\x66\x00\x00\x00\x67\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\xe2\x00\x6d\x00\x71\x00\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x00\x00\x00\x66\x00\x00\x00\x67\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\xf7\x00\x6d\x00\x00\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x65\x00\x6e\x00\x28\x02\x00\x00\xbd\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x65\x00\x00\x00\xe7\x00\x00\x00\xbd\x00\x00\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6e\x00\x71\x00\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x00\x69\x00\x6a\x00\xf9\x00\x00\x00\x6f\x00\x71\x00\x72\x00\x70\x00\x25\x00\x21\x03\x22\x03\x6e\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x23\x03\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x21\x03\x9d\x03\x6e\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x24\x03\x25\x03\x26\x03\x00\x00\x27\x03\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x00\x00\x46\x04\x94\x03\x69\x00\x6a\x00\x00\x00\x9e\x03\x25\x03\x26\x03\x00\x00\x27\x03\x00\x00\x71\x00\x72\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x2b\x04\x94\x03\x69\x00\x6a\x00\x00\x00\x2c\x04\x94\x03\x69\x00\x6a\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\x00\x00\x00\x00\x6e\x00\x13\x04\x94\x03\x69\x00\x6a\x00\x00\x00\xd3\x03\x94\x03\x69\x00\x6a\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x23\x00\x70\x00\x25\x00\xd6\x03\x94\x03\x69\x00\x6a\x00\x00\x00\x93\x03\x94\x03\x69\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\x00\x00\x00\x00\x00\x00\x00\xd0\x00\x00\x00\x6f\x00\x00\x00\x28\x03\x70\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x00\x00\x29\x03\x25\x00\x71\x00\x72\x00\xfb\x00\xfc\x00\x28\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x00\x00\x29\x03\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x71\x00\x72\x00\x70\x00\x25\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x71\x00\x72\x00\x70\x00\x25\x00\x6f\x00\x71\x00\x72\x00\x70\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x71\x00\x72\x00\x70\x00\x25\x00\x6f\x00\x71\x00\x72\x00\x70\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x00\x00\x00\x00\x00\x00\x71\x00\x72\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x6e\x02\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\xcc\x00\x58\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x5e\x03\x00\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x5f\x00\x00\x00\x90\x00\x00\x00\x60\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\x00\x00\x96\x00\x63\x00\x64\x00\x65\x00\x97\x00\x98\x00\x00\x00\x00\x00\x00\x00\x99\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xcd\x00\x39\x00\x00\x00\xce\x00\x00\x00\xcf\x00\x00\x00\xd0\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\xd1\x00\xd2\x00\xd3\x00\x00\x00\xd4\x00\x3c\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x5e\x03\x00\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x5f\x00\x00\x00\x90\x00\x00\x00\x60\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\x00\x00\x96\x00\x63\x00\x64\x00\x65\x00\x97\x00\x98\x00\x00\x00\x00\x00\x00\x00\x99\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x5f\x00\x28\x00\x90\x00\x00\x00\x60\x00\x2c\x00\x2d\x00\x91\x00\x00\x00\x40\xff\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\x00\x00\x96\x00\x63\x00\x64\x00\x65\x00\x97\x00\x98\x00\x74\x00\x00\x00\x75\x00\x99\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x76\x00\x00\x00\x00\x00\x00\x00\x40\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x03\x02\x01\x00\x00\xa1\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x74\x00\x57\x00\x75\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x76\x00\x00\x00\x40\xff\x5c\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x74\x00\x57\x00\x75\x00\x30\x04\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x76\x00\x00\x00\x00\x00\x5c\x00\x40\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x03\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x03\x00\x00\x00\x00\x00\x00\x62\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x7b\x02\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x7c\x02\x57\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x7a\x00\x00\x00\x5c\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x74\x00\x57\x00\x75\x00\x00\x00\x28\x00\x00\x00\x00\x00\x62\x00\x2c\x00\x2d\x00\x76\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x31\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\x2c\x03\x00\x00\x00\x00\x00\x00\x62\x00\x4d\x00\x00\x00\x76\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xa2\x03\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x03\x00\x00\x00\x00\x00\x00\x5c\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x62\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x2b\x03\x57\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x76\x00\x00\x00\x00\x00\x5c\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\x00\x00\x2d\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x03\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\x00\x00\x00\xdc\x00\xdd\x00\x9d\x03\xde\x00\xdf\x00\xc6\xfe\x00\x00\xc6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x5c\x00\x63\x01\xd8\x00\xd9\x00\xda\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\xe5\x02\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\xb0\x01\x3b\x00\x65\x01\x66\x01\x2d\x03\xde\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x67\x01\x68\x01\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x64\x00\x65\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x63\x01\xd8\x00\xd9\x00\xda\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xec\x02\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\xb0\x01\x3b\x00\x65\x01\x66\x01\x00\x00\xde\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x67\x01\x68\x01\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x64\x00\x65\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x63\x01\xd8\x00\xd9\x00\xda\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xaf\x01\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\xb0\x01\x3b\x00\x65\x01\x66\x01\x00\x00\xde\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x67\x01\x68\x01\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x64\x00\x65\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x63\x01\xd8\x00\xd9\x00\xda\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\xb7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\xb0\x01\x3b\x00\x65\x01\x66\x01\x00\x00\xde\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x67\x01\x68\x01\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x64\x00\x65\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x63\x01\xd8\x00\xd9\x00\xda\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x6b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\xee\x00\x3b\x00\x65\x01\x66\x01\x00\x00\xde\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x67\x01\x68\x01\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x64\x00\x65\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x73\x01\xd8\x00\xd9\x00\xda\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x74\x01\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\xee\x00\x3b\x00\x65\x01\x75\x01\x00\x00\xde\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x76\x01\x77\x01\x78\x01\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x64\x00\x65\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x63\x01\xd8\x00\xd9\x00\xda\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x64\x01\x00\x00\x3b\x00\x65\x01\x66\x01\x00\x00\xde\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x67\x01\x68\x01\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x64\x00\x65\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x63\x01\xd8\x00\xd9\x00\xda\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x65\x01\x66\x01\x00\x00\xde\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x67\x01\x68\x01\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\xde\x01\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x6e\x02\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\xdb\x02\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x03\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x63\x00\x64\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x6e\x02\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\xe7\x03\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x8b\x00\x8c\x00\x8d\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x03\x00\x00\x00\x00\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\xe7\x03\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x8b\x00\x8c\x00\x8d\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x03\x00\x00\x00\x00\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x6e\x02\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x85\x03\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x56\x01\x57\x01\x09\x01\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x90\x00\x19\x00\x00\x00\x00\x00\x00\x00\x86\x03\x00\x00\x00\x00\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x1c\x00\x39\x00\x00\x00\x1d\x00\x1e\x00\x6e\x02\x1f\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x9b\x01\x57\x00\x15\x00\x58\x00\x00\x00\x16\x00\x17\x00\x18\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x19\x00\x00\x00\x00\x00\x8b\x00\x8c\x00\x8d\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x1c\x00\x39\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x85\x03\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x54\x01\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x5f\x00\x00\x00\x90\x00\x00\x00\x00\x00\x19\x00\x00\x00\x86\x03\x00\x00\x00\x00\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x3d\x00\x00\x00\x3e\x00\x85\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x8b\x00\x8c\x00\x8d\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x92\x00\x93\x00\x94\x00\x95\x00\xbe\x02\x29\x00\x2a\x00\x2b\x00\xbf\x02\x2d\x00\x18\x01\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x01\xc0\x02\xc1\x02\xc2\x02\xc3\x02\x00\x00\xc4\x02\xc5\x02\xc6\x02\xc7\x02\xc8\x02\xc9\x02\x00\x00\xca\x02\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\x2c\x01\xcb\x02\xcc\x02\x2f\x01\xcd\x02\x31\x01\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\x3d\x01\x3e\x01\x3f\x01\x40\x01\x41\x01\x42\x01\xce\x02\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x01\x00\x00\x3d\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x08\x01\x09\x01\x17\x00\x18\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x19\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x62\x00\x1f\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x3d\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\xb4\x03\x17\x00\x18\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x19\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x00\x00\x39\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x62\x00\x1f\x00\x3a\x00\x16\x01\x00\x00\x3b\x00\x00\x00\x17\x01\x00\x00\x18\x01\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x40\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x01\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x00\x00\x1e\x01\x1f\x01\x20\x01\x21\x01\x22\x01\x23\x01\x62\x00\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\x2c\x01\x2d\x01\x2e\x01\x2f\x01\x30\x01\x31\x01\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\x3d\x01\x3e\x01\x3f\x01\x40\x01\x41\x01\x42\x01\x43\x01\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\x52\x02\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x74\x00\xf5\x00\x75\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\x00\x00\x00\x00\x00\x00\x76\x00\x00\x00\xee\x00\x00\x00\x00\x00\xdd\x00\x00\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\x00\x00\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x00\x00\xdc\x00\xdd\x00\x1c\x00\xde\x00\xeb\x03\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x26\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x28\x00\x57\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\xfe\x00\xd8\x00\x00\x00\xda\x00\x7a\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x74\x00\x00\x00\x75\x00\x2c\x00\x2d\x00\x00\x00\xfe\x00\xd8\x00\x00\x00\xda\x00\x76\x00\x62\x00\x00\x00\x00\x00\xff\x00\x00\x00\x00\x00\xde\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\x00\x01\x00\x00\x01\x01\x02\x01\x00\x00\x00\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\xff\x00\x00\x00\x00\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x2a\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\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x5c\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\xed\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x5c\x00\x76\x00\x28\x00\xee\x00\x2a\x00\x2b\x00\x2c\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\x62\x00\x00\x00\x00\x00\x00\x00\x74\x00\xab\x03\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x76\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x28\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x62\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x00\x00\x5c\x00\x51\x03\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x62\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x74\x00\x57\x00\x75\x00\x00\x00\x28\x00\x29\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x76\x00\x7a\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x6c\x03\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x74\x00\x57\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x76\x00\x7a\x00\x00\x00\x5c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x00\x00\x6d\x03\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x00\x00\x5c\x00\x00\x00\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x76\x00\xe9\x00\x00\x00\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\x00\x28\x00\x29\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x4b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x62\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x5c\x00\x57\x00\x00\x00\x28\x00\x29\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x7a\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x62\x00\x57\x00\x00\x00\x28\x00\x00\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x6d\x03\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x76\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x62\x00\x57\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x5c\x00\x57\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\xbf\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\xc0\x00\x00\x00\x00\x00\xac\x00\x61\x04\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x00\x06\x04\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x74\x00\x00\x00\x75\x00\x2c\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x76\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x02\x5a\x00\x5b\x00\x00\x00\x5c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x62\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x28\x00\x29\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x5c\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x3e\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x5a\x00\x5b\x00\x62\x00\x5c\x00\x28\x00\x00\x00\xa1\x01\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\xa2\x01\x00\x00\x00\x00\x00\x00\x00\x00\xae\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\xac\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x00\x00\x5c\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x4b\x01\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x5a\x00\x5b\x00\x2c\x00\x5c\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\xac\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x6c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\xae\x00\x00\x00\x00\x00\x62\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\xdd\x03\x5c\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x28\x00\x00\x00\x00\x00\x62\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x76\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x28\x00\x57\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\x00\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\x00\x62\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\xa0\x01\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x5c\x00\x00\x00\x00\x00\xa2\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x62\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x76\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x5c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x76\x00\x5c\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x00\x00\x00\x75\x00\x00\x00\x00\x00\x62\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x76\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x46\x01\x00\x00\x47\x01\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x01\x00\x00\x00\x00\xac\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x5c\x00\x57\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x62\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\xac\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x31\x03\x4d\x00\x4e\x00\x4f\x00\x50\x00\x62\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x62\x00\x57\x00\x00\x00\x51\x03\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x5a\x00\x5b\x00\x2c\x00\x5c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x28\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\xf7\x01\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\xa3\x03\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x1d\xff\x00\x00\x00\x00\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\xf7\x01\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x62\x00\x57\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\x00\x00\x00\x00\xf8\x01\x00\x00\x00\x00\x28\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdc\x00\xdd\x00\x62\x00\xde\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x81\x01\x82\x01\x83\x01\x84\x01\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x1d\xff\x1d\xff\x1d\xff\x1d\xff\x00\x00\x1d\xff\x1d\xff\x1d\xff\x1d\xff\x1d\xff\x1d\xff\x5c\x00\x1d\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xff\x00\x00\x4d\x00\x77\x00\x78\x00\x79\x00\x62\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xff\x83\x02\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x5c\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd5\x02\xd6\x02\xd7\x02\xd8\x02\x00\x00\xd9\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x83\x02\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x03\xd7\x02\xd8\x02\x00\x00\xd9\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x83\x02\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x03\xd8\x02\x00\x00\xd9\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x83\x02\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x04\x85\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x0f\x03\x00\x00\xdc\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x83\x02\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x02\x85\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xac\x02\x00\x00\xdc\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x83\x02\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd2\x02\x85\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xdb\x01\x00\x00\xdc\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xde\x01\x00\x00\xdc\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x83\x02\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x04\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x19\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x26\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x25\x04\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x1f\x04\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x26\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xbd\x03\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\xbe\x03\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x26\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xbf\x03\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\xf0\x03\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x26\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x7a\x03\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x8f\x03\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x26\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x90\x03\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\xfe\x02\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x26\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x88\x02\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\xa2\x01\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x26\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x4f\x01\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x50\x01\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x26\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x9b\x00\x9c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x6b\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x6c\x01\x6d\x01\x00\x00\x00\x00\x00\x00\x6e\x01\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\x6f\x01\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x70\x01\x5f\x01\xd4\x00\x60\x01\x71\x01\x26\x00\x58\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x59\x01\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x01\x5b\x01\x58\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x68\x01\x69\x01\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\xd0\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x5f\x01\x00\x00\x60\x01\x61\x01\x26\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\xd0\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x5f\x01\x00\x00\x60\x01\x61\x01\x26\x00\xdc\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\xdd\x02\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\xde\x02\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\xd0\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x5f\x01\x00\x00\x60\x01\x61\x01\x26\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\xd0\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x5f\x01\x00\x00\x60\x01\x61\x01\x26\x00\x58\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\xe3\x02\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\xea\x02\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\xd0\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x5f\x01\x00\x00\x60\x01\x61\x01\x26\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\xd0\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x5f\x01\x00\x00\x60\x01\x61\x01\x26\x00\x58\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\xad\x01\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\xb5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\xd0\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x5f\x01\x00\x00\x60\x01\x61\x01\x26\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x5c\x01\x00\x00\x5d\x01\x00\x00\x00\x00\x5e\x01\xd0\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xd1\x00\xd2\x00\x00\x00\x5f\x01\x00\x00\x60\x01\x61\x01\x26\x00\x99\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x99\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\xb1\x03\xb2\x03\x00\x00\x19\x00\x00\x00\xb3\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x1e\x04\x00\x00\x00\x00\x00\x00\xb3\x03\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\xb6\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x02\x00\x00\x19\x00\xe6\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe7\x02\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x51\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x01\x00\x00\x19\x00\x99\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9a\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x4a\x04\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x1d\x04\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\xbc\x03\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\xf8\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x0e\x03\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\xa9\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\xaa\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\xb0\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\xb1\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\xd3\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\xd4\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\xdb\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\xe5\x02\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x95\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x96\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x97\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x98\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x0d\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x0f\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x11\x01\x0f\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x51\x03\x10\x00\x4e\x01\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\xb9\x01\x10\x00\x4e\x01\x12\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x9a\x01\x1f\x00\x26\x00\x9b\x01\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x19\x00\x00\x00\x4d\x01\x10\x00\x4e\x01\x12\x00\x00\x00\x26\x00\x13\x00\x14\x00\x15\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\xb9\x02\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x19\x00\x00\x00\x00\x00\xba\x02\x13\x01\x14\x01\x00\x00\xbb\x02\x58\x03\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x02\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\xba\x02\x13\x01\x14\x01\x00\x00\xbb\x02\xbc\x02\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x01\x17\x00\x18\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x01\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x01\x17\x00\x18\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x01\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x02\x17\x00\x18\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x02\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\x00\x17\x00\x18\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x01\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x01\x17\x00\x18\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x01\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1c\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x00\x00\x1f\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (8, 629) [ (8 , happyReduce_8), (9 , happyReduce_9), (10 , happyReduce_10), (11 , happyReduce_11), (12 , happyReduce_12), (13 , happyReduce_13), (14 , happyReduce_14), (15 , happyReduce_15), (16 , happyReduce_16), (17 , happyReduce_17), (18 , happyReduce_18), (19 , happyReduce_19), (20 , happyReduce_20), (21 , happyReduce_21), (22 , happyReduce_22), (23 , happyReduce_23), (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), (112 , happyReduce_112), (113 , happyReduce_113), (114 , happyReduce_114), (115 , happyReduce_115), (116 , happyReduce_116), (117 , happyReduce_117), (118 , happyReduce_118), (119 , happyReduce_119), (120 , happyReduce_120), (121 , happyReduce_121), (122 , happyReduce_122), (123 , happyReduce_123), (124 , happyReduce_124), (125 , happyReduce_125), (126 , happyReduce_126), (127 , happyReduce_127), (128 , happyReduce_128), (129 , happyReduce_129), (130 , happyReduce_130), (131 , happyReduce_131), (132 , happyReduce_132), (133 , happyReduce_133), (134 , happyReduce_134), (135 , happyReduce_135), (136 , happyReduce_136), (137 , happyReduce_137), (138 , happyReduce_138), (139 , happyReduce_139), (140 , happyReduce_140), (141 , happyReduce_141), (142 , happyReduce_142), (143 , happyReduce_143), (144 , happyReduce_144), (145 , happyReduce_145), (146 , happyReduce_146), (147 , happyReduce_147), (148 , happyReduce_148), (149 , happyReduce_149), (150 , happyReduce_150), (151 , happyReduce_151), (152 , happyReduce_152), (153 , happyReduce_153), (154 , happyReduce_154), (155 , happyReduce_155), (156 , happyReduce_156), (157 , happyReduce_157), (158 , happyReduce_158), (159 , happyReduce_159), (160 , happyReduce_160), (161 , happyReduce_161), (162 , happyReduce_162), (163 , happyReduce_163), (164 , happyReduce_164), (165 , happyReduce_165), (166 , happyReduce_166), (167 , happyReduce_167), (168 , happyReduce_168), (169 , happyReduce_169), (170 , happyReduce_170), (171 , happyReduce_171), (172 , happyReduce_172), (173 , happyReduce_173), (174 , happyReduce_174), (175 , happyReduce_175), (176 , happyReduce_176), (177 , happyReduce_177), (178 , happyReduce_178), (179 , happyReduce_179), (180 , happyReduce_180), (181 , happyReduce_181), (182 , happyReduce_182), (183 , happyReduce_183), (184 , happyReduce_184), (185 , happyReduce_185), (186 , happyReduce_186), (187 , happyReduce_187), (188 , happyReduce_188), (189 , happyReduce_189), (190 , happyReduce_190), (191 , happyReduce_191), (192 , happyReduce_192), (193 , happyReduce_193), (194 , happyReduce_194), (195 , happyReduce_195), (196 , happyReduce_196), (197 , happyReduce_197), (198 , happyReduce_198), (199 , happyReduce_199), (200 , happyReduce_200), (201 , happyReduce_201), (202 , happyReduce_202), (203 , happyReduce_203), (204 , happyReduce_204), (205 , happyReduce_205), (206 , happyReduce_206), (207 , happyReduce_207), (208 , happyReduce_208), (209 , happyReduce_209), (210 , happyReduce_210), (211 , happyReduce_211), (212 , happyReduce_212), (213 , happyReduce_213), (214 , happyReduce_214), (215 , happyReduce_215), (216 , happyReduce_216), (217 , happyReduce_217), (218 , happyReduce_218), (219 , happyReduce_219), (220 , happyReduce_220), (221 , happyReduce_221), (222 , happyReduce_222), (223 , happyReduce_223), (224 , happyReduce_224), (225 , happyReduce_225), (226 , happyReduce_226), (227 , happyReduce_227), (228 , happyReduce_228), (229 , happyReduce_229), (230 , happyReduce_230), (231 , happyReduce_231), (232 , happyReduce_232), (233 , happyReduce_233), (234 , happyReduce_234), (235 , happyReduce_235), (236 , happyReduce_236), (237 , happyReduce_237), (238 , happyReduce_238), (239 , happyReduce_239), (240 , happyReduce_240), (241 , happyReduce_241), (242 , happyReduce_242), (243 , happyReduce_243), (244 , happyReduce_244), (245 , happyReduce_245), (246 , happyReduce_246), (247 , happyReduce_247), (248 , happyReduce_248), (249 , happyReduce_249), (250 , happyReduce_250), (251 , happyReduce_251), (252 , happyReduce_252), (253 , happyReduce_253), (254 , happyReduce_254), (255 , happyReduce_255), (256 , happyReduce_256), (257 , happyReduce_257), (258 , happyReduce_258), (259 , happyReduce_259), (260 , happyReduce_260), (261 , happyReduce_261), (262 , happyReduce_262), (263 , happyReduce_263), (264 , happyReduce_264), (265 , happyReduce_265), (266 , happyReduce_266), (267 , happyReduce_267), (268 , happyReduce_268), (269 , happyReduce_269), (270 , happyReduce_270), (271 , happyReduce_271), (272 , happyReduce_272), (273 , happyReduce_273), (274 , happyReduce_274), (275 , happyReduce_275), (276 , happyReduce_276), (277 , happyReduce_277), (278 , happyReduce_278), (279 , happyReduce_279), (280 , happyReduce_280), (281 , happyReduce_281), (282 , happyReduce_282), (283 , happyReduce_283), (284 , happyReduce_284), (285 , happyReduce_285), (286 , happyReduce_286), (287 , happyReduce_287), (288 , happyReduce_288), (289 , happyReduce_289), (290 , happyReduce_290), (291 , happyReduce_291), (292 , happyReduce_292), (293 , happyReduce_293), (294 , happyReduce_294), (295 , happyReduce_295), (296 , happyReduce_296), (297 , happyReduce_297), (298 , happyReduce_298), (299 , happyReduce_299), (300 , happyReduce_300), (301 , happyReduce_301), (302 , happyReduce_302), (303 , happyReduce_303), (304 , happyReduce_304), (305 , happyReduce_305), (306 , happyReduce_306), (307 , happyReduce_307), (308 , happyReduce_308), (309 , happyReduce_309), (310 , happyReduce_310), (311 , happyReduce_311), (312 , happyReduce_312), (313 , happyReduce_313), (314 , happyReduce_314), (315 , happyReduce_315), (316 , happyReduce_316), (317 , happyReduce_317), (318 , happyReduce_318), (319 , happyReduce_319), (320 , happyReduce_320), (321 , happyReduce_321), (322 , happyReduce_322), (323 , happyReduce_323), (324 , happyReduce_324), (325 , happyReduce_325), (326 , happyReduce_326), (327 , happyReduce_327), (328 , happyReduce_328), (329 , happyReduce_329), (330 , happyReduce_330), (331 , happyReduce_331), (332 , happyReduce_332), (333 , happyReduce_333), (334 , happyReduce_334), (335 , happyReduce_335), (336 , happyReduce_336), (337 , happyReduce_337), (338 , happyReduce_338), (339 , happyReduce_339), (340 , happyReduce_340), (341 , happyReduce_341), (342 , happyReduce_342), (343 , happyReduce_343), (344 , happyReduce_344), (345 , happyReduce_345), (346 , happyReduce_346), (347 , happyReduce_347), (348 , happyReduce_348), (349 , happyReduce_349), (350 , happyReduce_350), (351 , happyReduce_351), (352 , happyReduce_352), (353 , happyReduce_353), (354 , happyReduce_354), (355 , happyReduce_355), (356 , happyReduce_356), (357 , happyReduce_357), (358 , happyReduce_358), (359 , happyReduce_359), (360 , happyReduce_360), (361 , happyReduce_361), (362 , happyReduce_362), (363 , happyReduce_363), (364 , happyReduce_364), (365 , happyReduce_365), (366 , happyReduce_366), (367 , happyReduce_367), (368 , happyReduce_368), (369 , happyReduce_369), (370 , happyReduce_370), (371 , happyReduce_371), (372 , happyReduce_372), (373 , happyReduce_373), (374 , happyReduce_374), (375 , happyReduce_375), (376 , happyReduce_376), (377 , happyReduce_377), (378 , happyReduce_378), (379 , happyReduce_379), (380 , happyReduce_380), (381 , happyReduce_381), (382 , happyReduce_382), (383 , happyReduce_383), (384 , happyReduce_384), (385 , happyReduce_385), (386 , happyReduce_386), (387 , happyReduce_387), (388 , happyReduce_388), (389 , happyReduce_389), (390 , happyReduce_390), (391 , happyReduce_391), (392 , happyReduce_392), (393 , happyReduce_393), (394 , happyReduce_394), (395 , happyReduce_395), (396 , happyReduce_396), (397 , happyReduce_397), (398 , happyReduce_398), (399 , happyReduce_399), (400 , happyReduce_400), (401 , happyReduce_401), (402 , happyReduce_402), (403 , happyReduce_403), (404 , happyReduce_404), (405 , happyReduce_405), (406 , happyReduce_406), (407 , happyReduce_407), (408 , happyReduce_408), (409 , happyReduce_409), (410 , happyReduce_410), (411 , happyReduce_411), (412 , happyReduce_412), (413 , happyReduce_413), (414 , happyReduce_414), (415 , happyReduce_415), (416 , happyReduce_416), (417 , happyReduce_417), (418 , happyReduce_418), (419 , happyReduce_419), (420 , happyReduce_420), (421 , happyReduce_421), (422 , happyReduce_422), (423 , happyReduce_423), (424 , happyReduce_424), (425 , happyReduce_425), (426 , happyReduce_426), (427 , happyReduce_427), (428 , happyReduce_428), (429 , happyReduce_429), (430 , happyReduce_430), (431 , happyReduce_431), (432 , happyReduce_432), (433 , happyReduce_433), (434 , happyReduce_434), (435 , happyReduce_435), (436 , happyReduce_436), (437 , happyReduce_437), (438 , happyReduce_438), (439 , happyReduce_439), (440 , happyReduce_440), (441 , happyReduce_441), (442 , happyReduce_442), (443 , happyReduce_443), (444 , happyReduce_444), (445 , happyReduce_445), (446 , happyReduce_446), (447 , happyReduce_447), (448 , happyReduce_448), (449 , happyReduce_449), (450 , happyReduce_450), (451 , happyReduce_451), (452 , happyReduce_452), (453 , happyReduce_453), (454 , happyReduce_454), (455 , happyReduce_455), (456 , happyReduce_456), (457 , happyReduce_457), (458 , happyReduce_458), (459 , happyReduce_459), (460 , happyReduce_460), (461 , happyReduce_461), (462 , happyReduce_462), (463 , happyReduce_463), (464 , happyReduce_464), (465 , happyReduce_465), (466 , happyReduce_466), (467 , happyReduce_467), (468 , happyReduce_468), (469 , happyReduce_469), (470 , happyReduce_470), (471 , happyReduce_471), (472 , happyReduce_472), (473 , happyReduce_473), (474 , happyReduce_474), (475 , happyReduce_475), (476 , happyReduce_476), (477 , happyReduce_477), (478 , happyReduce_478), (479 , happyReduce_479), (480 , happyReduce_480), (481 , happyReduce_481), (482 , happyReduce_482), (483 , happyReduce_483), (484 , happyReduce_484), (485 , happyReduce_485), (486 , happyReduce_486), (487 , happyReduce_487), (488 , happyReduce_488), (489 , happyReduce_489), (490 , happyReduce_490), (491 , happyReduce_491), (492 , happyReduce_492), (493 , happyReduce_493), (494 , happyReduce_494), (495 , happyReduce_495), (496 , happyReduce_496), (497 , happyReduce_497), (498 , happyReduce_498), (499 , happyReduce_499), (500 , happyReduce_500), (501 , happyReduce_501), (502 , happyReduce_502), (503 , happyReduce_503), (504 , happyReduce_504), (505 , happyReduce_505), (506 , happyReduce_506), (507 , happyReduce_507), (508 , happyReduce_508), (509 , happyReduce_509), (510 , happyReduce_510), (511 , happyReduce_511), (512 , happyReduce_512), (513 , happyReduce_513), (514 , happyReduce_514), (515 , happyReduce_515), (516 , happyReduce_516), (517 , happyReduce_517), (518 , happyReduce_518), (519 , happyReduce_519), (520 , happyReduce_520), (521 , happyReduce_521), (522 , happyReduce_522), (523 , happyReduce_523), (524 , happyReduce_524), (525 , happyReduce_525), (526 , happyReduce_526), (527 , happyReduce_527), (528 , happyReduce_528), (529 , happyReduce_529), (530 , happyReduce_530), (531 , happyReduce_531), (532 , happyReduce_532), (533 , happyReduce_533), (534 , happyReduce_534), (535 , happyReduce_535), (536 , happyReduce_536), (537 , happyReduce_537), (538 , happyReduce_538), (539 , happyReduce_539), (540 , happyReduce_540), (541 , happyReduce_541), (542 , happyReduce_542), (543 , happyReduce_543), (544 , happyReduce_544), (545 , happyReduce_545), (546 , happyReduce_546), (547 , happyReduce_547), (548 , happyReduce_548), (549 , happyReduce_549), (550 , happyReduce_550), (551 , happyReduce_551), (552 , happyReduce_552), (553 , happyReduce_553), (554 , happyReduce_554), (555 , happyReduce_555), (556 , happyReduce_556), (557 , happyReduce_557), (558 , happyReduce_558), (559 , happyReduce_559), (560 , happyReduce_560), (561 , happyReduce_561), (562 , happyReduce_562), (563 , happyReduce_563), (564 , happyReduce_564), (565 , happyReduce_565), (566 , happyReduce_566), (567 , happyReduce_567), (568 , happyReduce_568), (569 , happyReduce_569), (570 , happyReduce_570), (571 , happyReduce_571), (572 , happyReduce_572), (573 , happyReduce_573), (574 , happyReduce_574), (575 , happyReduce_575), (576 , happyReduce_576), (577 , happyReduce_577), (578 , happyReduce_578), (579 , happyReduce_579), (580 , happyReduce_580), (581 , happyReduce_581), (582 , happyReduce_582), (583 , happyReduce_583), (584 , happyReduce_584), (585 , happyReduce_585), (586 , happyReduce_586), (587 , happyReduce_587), (588 , happyReduce_588), (589 , happyReduce_589), (590 , happyReduce_590), (591 , happyReduce_591), (592 , happyReduce_592), (593 , happyReduce_593), (594 , happyReduce_594), (595 , happyReduce_595), (596 , happyReduce_596), (597 , happyReduce_597), (598 , happyReduce_598), (599 , happyReduce_599), (600 , happyReduce_600), (601 , happyReduce_601), (602 , happyReduce_602), (603 , happyReduce_603), (604 , happyReduce_604), (605 , happyReduce_605), (606 , happyReduce_606), (607 , happyReduce_607), (608 , happyReduce_608), (609 , happyReduce_609), (610 , happyReduce_610), (611 , happyReduce_611), (612 , happyReduce_612), (613 , happyReduce_613), (614 , happyReduce_614), (615 , happyReduce_615), (616 , happyReduce_616), (617 , happyReduce_617), (618 , happyReduce_618), (619 , happyReduce_619), (620 , happyReduce_620), (621 , happyReduce_621), (622 , happyReduce_622), (623 , happyReduce_623), (624 , happyReduce_624), (625 , happyReduce_625), (626 , happyReduce_626), (627 , happyReduce_627), (628 , happyReduce_628), (629 , happyReduce_629) ] happy_n_terms = 141 :: Int happy_n_nonterms = 223 :: Int happyReduce_8 = happySpecReduce_2 0# happyReduction_8 happyReduction_8 happy_x_2 happy_x_1 = case happyOut15 happy_x_1 of { happy_var_1 -> case happyOut12 happy_x_2 of { happy_var_2 -> happyIn11 (let (os,ss,l) = happy_var_1 in map (\x -> x os ss l) happy_var_2 )}} happyReduce_9 = happySpecReduce_2 1# happyReduction_9 happyReduction_9 happy_x_2 happy_x_1 = case happyOut19 happy_x_1 of { happy_var_1 -> case happyOut12 happy_x_2 of { happy_var_2 -> happyIn12 (happy_var_1 : happy_var_2 )}} happyReduce_10 = happySpecReduce_1 1# happyReduction_10 happyReduction_10 happy_x_1 = case happyOut19 happy_x_1 of { happy_var_1 -> happyIn12 ([happy_var_1] )} happyReduce_11 = happyMonadReduce 2# 2# happyReduction_11 happyReduction_11 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut15 happy_x_1 of { happy_var_1 -> case happyOut14 happy_x_2 of { happy_var_2 -> ( checkPageModule happy_var_2 happy_var_1)}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_12 = happyMonadReduce 5# 2# happyReduction_12 happyReduction_12 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut15 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 XCodeTagOpen) -> case happyOut19 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 XCodeTagClose) -> case happyOut14 happy_x_5 of { happy_var_5 -> ( let (os,ss,l) = happy_var_1 in checkHybridModule happy_var_5 (happy_var_3 os ss l) happy_var_2 happy_var_4)}}}}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_13 = happySpecReduce_2 2# happyReduction_13 happyReduction_13 happy_x_2 happy_x_1 = case happyOut15 happy_x_1 of { happy_var_1 -> case happyOut19 happy_x_2 of { happy_var_2 -> happyIn13 (let (os,ss,l) = happy_var_1 in happy_var_2 os ss l )}} happyReduce_14 = happyMonadReduce 9# 3# happyReduction_14 happyReduction_14 (happy_x_9 `HappyStk` happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 XStdTagOpen) -> case happyOut164 happy_x_2 of { happy_var_2 -> case happyOut167 happy_x_3 of { happy_var_3 -> case happyOut169 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 XStdTagClose) -> case happyOut162 happy_x_6 of { happy_var_6 -> case happyOutTok happy_x_7 of { (Loc happy_var_7 XCloseTagOpen) -> case happyOut164 happy_x_8 of { happy_var_8 -> case happyOutTok happy_x_9 of { (Loc happy_var_9 XStdTagClose) -> ( do { n <- checkEqNames happy_var_2 happy_var_8; let { cn = reverse happy_var_6; as = reverse happy_var_3; }; return $ XTag (happy_var_1 <^^> happy_var_9 <** [happy_var_1,happy_var_5,happy_var_7,happy_var_9]) n as happy_var_4 cn })}}}}}}}}} ) (\r -> happyReturn (happyIn14 r)) happyReduce_15 = happyReduce 5# 3# happyReduction_15 happyReduction_15 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 XStdTagOpen) -> case happyOut164 happy_x_2 of { happy_var_2 -> case happyOut167 happy_x_3 of { happy_var_3 -> case happyOut169 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 XEmptyTagClose) -> happyIn14 (XETag (happy_var_1 <^^> happy_var_5 <** [happy_var_1,happy_var_5]) happy_var_2 (reverse happy_var_3) happy_var_4 ) `HappyStk` happyRest}}}}} happyReduce_16 = happySpecReduce_3 4# happyReduction_16 happyReduction_16 happy_x_3 happy_x_2 happy_x_1 = case happyOut225 happy_x_1 of { happy_var_1 -> case happyOut16 happy_x_2 of { happy_var_2 -> case happyOut226 happy_x_3 of { happy_var_3 -> happyIn15 (let (os,ss,ml) = happy_var_2 in (os,happy_var_1:ss++[happy_var_3],happy_var_1 <^^> happy_var_3) )}}} happyReduce_17 = happySpecReduce_3 5# happyReduction_17 happyReduction_17 happy_x_3 happy_x_2 happy_x_1 = case happyOut17 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 SemiColon) -> case happyOut16 happy_x_3 of { happy_var_3 -> happyIn16 (let (os,ss,ml) = happy_var_3 in (happy_var_1 : os, happy_var_2 : ss, Just $ ann happy_var_1 <++> nIS happy_var_2 <+?> ml) )}}} happyReduce_18 = happySpecReduce_0 5# happyReduction_18 happyReduction_18 = happyIn16 (([],[],Nothing) ) happyReduce_19 = happyReduce 4# 6# happyReduction_19 happyReduction_19 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LANGUAGE) -> case happyOut18 happy_x_2 of { happy_var_2 -> case happyOut25 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 PragmaEnd) -> happyIn17 (LanguagePragma (happy_var_1 <^^> happy_var_4 <** (happy_var_1:snd happy_var_2 ++ reverse happy_var_3 ++ [happy_var_4])) (fst happy_var_2) ) `HappyStk` happyRest}}}} happyReduce_20 = happySpecReduce_3 6# happyReduction_20 happyReduction_20 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut25 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> happyIn17 (let Loc l (OPTIONS (mc, s)) = happy_var_1 in OptionsPragma (l <^^> happy_var_3 <** (l:reverse happy_var_2 ++ [happy_var_3])) (readTool mc) s )}}} happyReduce_21 = happySpecReduce_3 6# happyReduction_21 happyReduction_21 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 ANN) -> case happyOut76 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> happyIn17 (AnnModulePragma (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) happy_var_2 )}}} happyReduce_22 = happySpecReduce_3 7# happyReduction_22 happyReduction_22 happy_x_3 happy_x_2 happy_x_1 = case happyOut216 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut18 happy_x_3 of { happy_var_3 -> happyIn18 ((happy_var_1 : fst happy_var_3, happy_var_2 : snd happy_var_3) )}}} happyReduce_23 = happySpecReduce_1 7# happyReduction_23 happyReduction_23 happy_x_1 = case happyOut216 happy_x_1 of { happy_var_1 -> happyIn18 (([happy_var_1],[]) )} happyReduce_24 = happySpecReduce_2 8# happyReduction_24 happyReduction_24 happy_x_2 happy_x_1 = case happyOut20 happy_x_1 of { happy_var_1 -> case happyOut22 happy_x_2 of { happy_var_2 -> happyIn19 (let (is,ds,ss1,inf) = happy_var_2 in \os ss l -> Module (l <++> inf <** (ss ++ ss1)) happy_var_1 os is ds )}} happyReduce_25 = happyReduce 5# 9# happyReduction_25 happyReduction_25 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Module) -> case happyOut227 happy_x_2 of { happy_var_2 -> case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut26 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 KW_Where) -> happyIn20 (Just $ ModuleHead (happy_var_1 <^^> happy_var_5 <** [happy_var_1,happy_var_5]) happy_var_2 happy_var_3 happy_var_4 ) `HappyStk` happyRest}}}}} happyReduce_26 = happySpecReduce_0 9# happyReduction_26 happyReduction_26 = happyIn20 (Nothing ) happyReduce_27 = happySpecReduce_3 10# happyReduction_27 happyReduction_27 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 DEPRECATED) -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> happyIn21 (let Loc l (StringTok (s,_)) = happy_var_2 in Just $ DeprText (happy_var_1 <^^> happy_var_3 <** [happy_var_1,l,happy_var_3]) s )}}} happyReduce_28 = happySpecReduce_3 10# happyReduction_28 happyReduction_28 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 WARNING) -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> happyIn21 (let Loc l (StringTok (s,_)) = happy_var_2 in Just $ WarnText (happy_var_1 <^^> happy_var_3 <** [happy_var_1,l,happy_var_3]) s )}}} happyReduce_29 = happySpecReduce_0 10# happyReduction_29 happyReduction_29 = happyIn21 (Nothing ) happyReduce_30 = happySpecReduce_3 11# happyReduction_30 happyReduction_30 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftCurly) -> case happyOut23 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightCurly) -> happyIn22 (let (is,ds,ss) = happy_var_2 in (is,ds,happy_var_1:ss ++ [happy_var_3], happy_var_1 <^^> happy_var_3) )}}} happyReduce_31 = happySpecReduce_3 11# happyReduction_31 happyReduction_31 happy_x_3 happy_x_2 happy_x_1 = case happyOut225 happy_x_1 of { happy_var_1 -> case happyOut23 happy_x_2 of { happy_var_2 -> case happyOut226 happy_x_3 of { happy_var_3 -> happyIn22 (let (is,ds,ss) = happy_var_2 in (is,ds,happy_var_1:ss ++ [happy_var_3], happy_var_1 <^^> happy_var_3) )}}} happyReduce_32 = happyReduce 4# 12# happyReduction_32 happyReduction_32 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut31 happy_x_2 of { happy_var_2 -> case happyOut24 happy_x_3 of { happy_var_3 -> case happyOut48 happy_x_4 of { happy_var_4 -> happyIn23 ((reverse (fst happy_var_2), fst happy_var_4, reverse happy_var_1 ++ snd happy_var_2 ++ reverse happy_var_3 ++ snd happy_var_4) ) `HappyStk` happyRest}}}} happyReduce_33 = happySpecReduce_2 12# happyReduction_33 happyReduction_33 happy_x_2 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut48 happy_x_2 of { happy_var_2 -> happyIn23 (([], fst happy_var_2, reverse happy_var_1 ++ snd happy_var_2) )}} happyReduce_34 = happySpecReduce_3 12# happyReduction_34 happyReduction_34 happy_x_3 happy_x_2 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut31 happy_x_2 of { happy_var_2 -> case happyOut25 happy_x_3 of { happy_var_3 -> happyIn23 ((reverse (fst happy_var_2), [], reverse happy_var_1 ++ snd happy_var_2 ++ reverse happy_var_3) )}}} happyReduce_35 = happySpecReduce_1 12# happyReduction_35 happyReduction_35 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> happyIn23 (([], [], reverse happy_var_1) )} happyReduce_36 = happySpecReduce_2 13# happyReduction_36 happyReduction_36 happy_x_2 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 SemiColon) -> happyIn24 (happy_var_2 : happy_var_1 )}} happyReduce_37 = happySpecReduce_1 14# happyReduction_37 happyReduction_37 happy_x_1 = case happyOut24 happy_x_1 of { happy_var_1 -> happyIn25 (happy_var_1 )} happyReduce_38 = happySpecReduce_0 14# happyReduction_38 happyReduction_38 = happyIn25 ([] ) happyReduce_39 = happySpecReduce_1 15# happyReduction_39 happyReduction_39 happy_x_1 = case happyOut27 happy_x_1 of { happy_var_1 -> happyIn26 (Just happy_var_1 )} happyReduce_40 = happySpecReduce_0 15# happyReduction_40 happyReduction_40 = happyIn26 (Nothing ) happyReduce_41 = happyReduce 4# 16# happyReduction_41 happyReduction_41 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut29 happy_x_2 of { happy_var_2 -> case happyOut28 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn27 (ExportSpecList (happy_var_1 <^^> happy_var_4 <** (happy_var_1:reverse (snd happy_var_2) ++ happy_var_3 ++ [happy_var_4])) (reverse (fst happy_var_2)) ) `HappyStk` happyRest}}}} happyReduce_42 = happySpecReduce_3 16# happyReduction_42 happyReduction_42 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut28 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn27 (ExportSpecList (happy_var_1 <^^> happy_var_3 <** (happy_var_1:happy_var_2++[happy_var_3])) [] )}}} happyReduce_43 = happySpecReduce_1 17# happyReduction_43 happyReduction_43 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Comma) -> happyIn28 ([happy_var_1] )} happyReduce_44 = happySpecReduce_0 17# happyReduction_44 happyReduction_44 = happyIn28 ([ ] ) happyReduce_45 = happySpecReduce_3 18# happyReduction_45 happyReduction_45 happy_x_3 happy_x_2 happy_x_1 = case happyOut29 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut30 happy_x_3 of { happy_var_3 -> happyIn29 ((happy_var_3 : fst happy_var_1, happy_var_2 : snd happy_var_1) )}}} happyReduce_46 = happySpecReduce_1 18# happyReduction_46 happyReduction_46 happy_x_1 = case happyOut30 happy_x_1 of { happy_var_1 -> happyIn29 (([happy_var_1],[]) )} happyReduce_47 = happySpecReduce_1 19# happyReduction_47 happyReduction_47 happy_x_1 = case happyOut198 happy_x_1 of { happy_var_1 -> happyIn30 (EVar (ann happy_var_1) happy_var_1 )} happyReduce_48 = happySpecReduce_1 19# happyReduction_48 happyReduction_48 happy_x_1 = case happyOut229 happy_x_1 of { happy_var_1 -> happyIn30 (EAbs (ann happy_var_1) happy_var_1 )} happyReduce_49 = happyReduce 4# 19# happyReduction_49 happyReduction_49 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut229 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 DotDot) -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn30 (EThingAll (ann happy_var_1 <++> nIS happy_var_4 <** [happy_var_2,happy_var_3,happy_var_4]) happy_var_1 ) `HappyStk` happyRest}}}} happyReduce_50 = happySpecReduce_3 19# happyReduction_50 happyReduction_50 happy_x_3 happy_x_2 happy_x_1 = case happyOut229 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn30 (EThingWith (ann happy_var_1 <++> nIS happy_var_3 <** [happy_var_2,happy_var_3]) happy_var_1 [] )}}} happyReduce_51 = happyReduce 4# 19# happyReduction_51 happyReduction_51 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut229 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOut42 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn30 (EThingWith (ann happy_var_1 <++> nIS happy_var_4 <** (happy_var_2:reverse (snd happy_var_3) ++ [happy_var_4])) happy_var_1 (reverse (fst happy_var_3)) ) `HappyStk` happyRest}}}} happyReduce_52 = happySpecReduce_2 19# happyReduction_52 happyReduction_52 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Module) -> case happyOut227 happy_x_2 of { happy_var_2 -> happyIn30 (EModuleContents (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_53 = happySpecReduce_3 20# happyReduction_53 happyReduction_53 happy_x_3 happy_x_2 happy_x_1 = case happyOut31 happy_x_1 of { happy_var_1 -> case happyOut24 happy_x_2 of { happy_var_2 -> case happyOut32 happy_x_3 of { happy_var_3 -> happyIn31 ((happy_var_3 : fst happy_var_1, snd happy_var_1 ++ reverse happy_var_2) )}}} happyReduce_54 = happySpecReduce_1 20# happyReduction_54 happyReduction_54 happy_x_1 = case happyOut32 happy_x_1 of { happy_var_1 -> happyIn31 (([happy_var_1],[]) )} happyReduce_55 = happyReduce 7# 21# happyReduction_55 happyReduction_55 (happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Import) -> case happyOut33 happy_x_2 of { happy_var_2 -> case happyOut34 happy_x_3 of { happy_var_3 -> case happyOut35 happy_x_4 of { happy_var_4 -> case happyOut227 happy_x_5 of { happy_var_5 -> case happyOut36 happy_x_6 of { happy_var_6 -> case happyOut37 happy_x_7 of { happy_var_7 -> happyIn32 (let { (mmn,ss,ml) = happy_var_6 ; l = nIS happy_var_1 <++> ann happy_var_5 <+?> ml <+?> (fmap ann) happy_var_7 <** (happy_var_1:snd happy_var_2 ++ snd happy_var_3 ++ snd happy_var_4 ++ ss)} in ImportDecl l happy_var_5 (fst happy_var_3) (fst happy_var_2) (fst happy_var_4) mmn happy_var_7 ) `HappyStk` happyRest}}}}}}} happyReduce_56 = happySpecReduce_2 22# happyReduction_56 happyReduction_56 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 SOURCE) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 PragmaEnd) -> happyIn33 ((True,[happy_var_1,happy_var_2]) )}} happyReduce_57 = happySpecReduce_0 22# happyReduction_57 happyReduction_57 = happyIn33 ((False,[]) ) happyReduce_58 = happySpecReduce_1 23# happyReduction_58 happyReduction_58 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Qualified) -> happyIn34 ((True,[happy_var_1]) )} happyReduce_59 = happySpecReduce_0 23# happyReduction_59 happyReduction_59 = happyIn34 ((False, []) ) happyReduce_60 = happyMonadReduce 1# 24# happyReduction_60 happyReduction_60 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( do { checkEnabled PackageImports ; let { Loc l (StringTok (s,_)) = happy_var_1 } ; return $ (Just s,[l]) })} ) (\r -> happyReturn (happyIn35 r)) happyReduce_61 = happySpecReduce_0 24# happyReduction_61 happyReduction_61 = happyIn35 ((Nothing,[]) ) happyReduce_62 = happySpecReduce_2 25# happyReduction_62 happyReduction_62 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_As) -> case happyOut227 happy_x_2 of { happy_var_2 -> happyIn36 ((Just happy_var_2,[happy_var_1],Just (nIS happy_var_1 <++> ann happy_var_2)) )}} happyReduce_63 = happySpecReduce_0 25# happyReduction_63 happyReduction_63 = happyIn36 ((Nothing,[],Nothing) ) happyReduce_64 = happySpecReduce_1 26# happyReduction_64 happyReduction_64 happy_x_1 = case happyOut38 happy_x_1 of { happy_var_1 -> happyIn37 (Just happy_var_1 )} happyReduce_65 = happySpecReduce_0 26# happyReduction_65 happyReduction_65 = happyIn37 (Nothing ) happyReduce_66 = happyReduce 5# 27# happyReduction_66 happyReduction_66 (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 { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOut40 happy_x_3 of { happy_var_3 -> case happyOut28 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 RightParen) -> happyIn38 (let {(b,ml,s) = happy_var_1 ; l = (ml (happy_var_2 <^^> happy_var_5)) <** (s ++ happy_var_2:reverse (snd happy_var_3) ++ happy_var_4 ++ [happy_var_5])} in ImportSpecList l b (reverse (fst happy_var_3)) ) `HappyStk` happyRest}}}}} happyReduce_67 = happyReduce 4# 27# happyReduction_67 happyReduction_67 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut39 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOut28 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn38 (let {(b,ml,s) = happy_var_1 ; l = (ml (happy_var_2 <^^> happy_var_4)) <** (s ++ happy_var_2:happy_var_3 ++ [happy_var_4])} in ImportSpecList l b [] ) `HappyStk` happyRest}}}} happyReduce_68 = happySpecReduce_1 28# happyReduction_68 happyReduction_68 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Hiding) -> happyIn39 ((True,Just (nIS happy_var_1),[happy_var_1]) )} happyReduce_69 = happySpecReduce_0 28# happyReduction_69 happyReduction_69 = happyIn39 ((False,Nothing,[]) ) happyReduce_70 = happySpecReduce_3 29# happyReduction_70 happyReduction_70 happy_x_3 happy_x_2 happy_x_1 = case happyOut40 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut41 happy_x_3 of { happy_var_3 -> happyIn40 ((happy_var_3 : fst happy_var_1, happy_var_2 : snd happy_var_1) )}}} happyReduce_71 = happySpecReduce_1 29# happyReduction_71 happyReduction_71 happy_x_1 = case happyOut41 happy_x_1 of { happy_var_1 -> happyIn40 (([happy_var_1],[]) )} happyReduce_72 = happySpecReduce_1 30# happyReduction_72 happyReduction_72 happy_x_1 = case happyOut196 happy_x_1 of { happy_var_1 -> happyIn41 (IVar (ann happy_var_1) happy_var_1 )} happyReduce_73 = happySpecReduce_1 30# happyReduction_73 happyReduction_73 happy_x_1 = case happyOut228 happy_x_1 of { happy_var_1 -> happyIn41 (IAbs (ann happy_var_1) happy_var_1 )} happyReduce_74 = happyReduce 4# 30# happyReduction_74 happyReduction_74 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut228 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 DotDot) -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn41 (IThingAll (ann happy_var_1 <++> nIS happy_var_4 <** [happy_var_2,happy_var_3,happy_var_4]) happy_var_1 ) `HappyStk` happyRest}}}} happyReduce_75 = happySpecReduce_3 30# happyReduction_75 happyReduction_75 happy_x_3 happy_x_2 happy_x_1 = case happyOut228 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn41 (IThingWith (ann happy_var_1 <++> nIS happy_var_3 <** [happy_var_2,happy_var_3]) happy_var_1 [] )}}} happyReduce_76 = happyReduce 4# 30# happyReduction_76 happyReduction_76 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut228 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOut42 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn41 (IThingWith (ann happy_var_1 <++> nIS happy_var_4 <** (happy_var_2:reverse (snd happy_var_3) ++ [happy_var_4])) happy_var_1 (reverse (fst happy_var_3)) ) `HappyStk` happyRest}}}} happyReduce_77 = happySpecReduce_3 31# happyReduction_77 happyReduction_77 happy_x_3 happy_x_2 happy_x_1 = case happyOut42 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut43 happy_x_3 of { happy_var_3 -> happyIn42 ((happy_var_3 : fst happy_var_1, happy_var_2 : snd happy_var_1) )}}} happyReduce_78 = happySpecReduce_1 31# happyReduction_78 happyReduction_78 happy_x_1 = case happyOut43 happy_x_1 of { happy_var_1 -> happyIn42 (([happy_var_1],[]) )} happyReduce_79 = happySpecReduce_1 32# happyReduction_79 happyReduction_79 happy_x_1 = case happyOut196 happy_x_1 of { happy_var_1 -> happyIn43 (VarName (ann happy_var_1) happy_var_1 )} happyReduce_80 = happySpecReduce_1 32# happyReduction_80 happyReduction_80 happy_x_1 = case happyOut200 happy_x_1 of { happy_var_1 -> happyIn43 (ConName (ann happy_var_1) happy_var_1 )} happyReduce_81 = happySpecReduce_3 33# happyReduction_81 happyReduction_81 happy_x_3 happy_x_2 happy_x_1 = case happyOut46 happy_x_1 of { happy_var_1 -> case happyOut45 happy_x_2 of { happy_var_2 -> case happyOut47 happy_x_3 of { happy_var_3 -> happyIn44 (let (ops,ss,l) = happy_var_3 in InfixDecl (ann happy_var_1 <++> l <** (snd happy_var_2 ++ reverse ss)) happy_var_1 (fst happy_var_2) (reverse ops) )}}} happyReduce_82 = happySpecReduce_0 34# happyReduction_82 happyReduction_82 = happyIn45 ((Nothing, []) ) happyReduce_83 = happyMonadReduce 1# 34# happyReduction_83 happyReduction_83 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> ( let Loc l (IntTok (i,_)) = happy_var_1 in checkPrec i >>= \i -> return (Just i, [l]))} ) (\r -> happyReturn (happyIn45 r)) happyReduce_84 = happySpecReduce_1 35# happyReduction_84 happyReduction_84 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Infix) -> happyIn46 (AssocNone $ nIS happy_var_1 )} happyReduce_85 = happySpecReduce_1 35# happyReduction_85 happyReduction_85 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_InfixL) -> happyIn46 (AssocLeft $ nIS happy_var_1 )} happyReduce_86 = happySpecReduce_1 35# happyReduction_86 happyReduction_86 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_InfixR) -> happyIn46 (AssocRight $ nIS happy_var_1 )} happyReduce_87 = happySpecReduce_3 36# happyReduction_87 happyReduction_87 happy_x_3 happy_x_2 happy_x_1 = case happyOut47 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut207 happy_x_3 of { happy_var_3 -> happyIn47 (let (ops,ss,l) = happy_var_1 in (happy_var_3 : ops, happy_var_2 : ss, l <++> ann happy_var_3) )}}} happyReduce_88 = happySpecReduce_1 36# happyReduction_88 happyReduction_88 happy_x_1 = case happyOut207 happy_x_1 of { happy_var_1 -> happyIn47 (([happy_var_1],[],ann happy_var_1) )} happyReduce_89 = happyMonadReduce 2# 37# happyReduction_89 happyReduction_89 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut49 happy_x_1 of { happy_var_1 -> case happyOut25 happy_x_2 of { happy_var_2 -> ( checkRevDecls (fst happy_var_1) >>= \ds -> return (ds, snd happy_var_1 ++ reverse happy_var_2))}} ) (\r -> happyReturn (happyIn48 r)) happyReduce_90 = happySpecReduce_3 38# happyReduction_90 happyReduction_90 happy_x_3 happy_x_2 happy_x_1 = case happyOut49 happy_x_1 of { happy_var_1 -> case happyOut24 happy_x_2 of { happy_var_2 -> case happyOut50 happy_x_3 of { happy_var_3 -> happyIn49 ((happy_var_3 : fst happy_var_1, snd happy_var_1 ++ reverse happy_var_2) )}}} happyReduce_91 = happySpecReduce_1 38# happyReduction_91 happyReduction_91 happy_x_1 = case happyOut50 happy_x_1 of { happy_var_1 -> happyIn49 (([happy_var_1],[]) )} happyReduce_92 = happyMonadReduce 4# 39# happyReduction_92 happyReduction_92 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Type) -> case happyOut78 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Equals) -> case happyOut88 happy_x_4 of { happy_var_4 -> ( do { dh <- checkSimpleType happy_var_2; let {l = nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_3]}; return (TypeDecl l dh happy_var_4) })}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_93 = happyMonadReduce 4# 39# happyReduction_93 happyReduction_93 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Type) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Family) -> case happyOut80 happy_x_3 of { happy_var_3 -> case happyOut122 happy_x_4 of { happy_var_4 -> ( do { dh <- checkSimpleType happy_var_3; let {l = nIS happy_var_1 <++> ann happy_var_3 <+?> (fmap ann) (fst happy_var_4) <** (happy_var_1:happy_var_2:snd happy_var_4)}; return (TypeFamDecl l dh (fst happy_var_4)) })}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_94 = happyMonadReduce 5# 39# happyReduction_94 happyReduction_94 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Type) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Instance) -> case happyOut77 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 Equals) -> case happyOut88 happy_x_5 of { happy_var_5 -> ( do { -- no checkSimpleType happy_var_4 since dtype may contain type patterns checkEnabled TypeFamilies ; let {l = nIS happy_var_1 <++> ann happy_var_5 <** [happy_var_1,happy_var_2,happy_var_4]}; return (TypeInsDecl l happy_var_3 happy_var_5) })}}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_95 = happyMonadReduce 4# 39# happyReduction_95 happyReduction_95 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut89 happy_x_2 of { happy_var_2 -> case happyOut104 happy_x_3 of { happy_var_3 -> case happyOut116 happy_x_4 of { happy_var_4 -> ( do { (cs,dh) <- checkDataHeader happy_var_2; let { (qds,ss,minf) = happy_var_3; l = happy_var_1 <> happy_var_2 <+?> minf <+?> fmap ann happy_var_4 <** ss}; checkDataOrNew happy_var_1 qds; return (DataDecl l happy_var_1 cs dh (reverse qds) happy_var_4) })}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_96 = happyMonadReduce 5# 39# happyReduction_96 happyReduction_96 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut89 happy_x_2 of { happy_var_2 -> case happyOut122 happy_x_3 of { happy_var_3 -> case happyOut100 happy_x_4 of { happy_var_4 -> case happyOut116 happy_x_5 of { happy_var_5 -> ( do { (cs,dh) <- checkDataHeader happy_var_2; let { (gs,ss,minf) = happy_var_4; l = ann happy_var_1 <+?> minf <+?> fmap ann happy_var_5 <** (snd happy_var_3 ++ ss)}; checkDataOrNewG happy_var_1 gs; case (gs, fst happy_var_3) of ([], Nothing) -> return (DataDecl l happy_var_1 cs dh [] happy_var_5) _ -> checkEnabled GADTs >> return (GDataDecl l happy_var_1 cs dh (fst happy_var_3) (reverse gs) happy_var_5) })}}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_97 = happyMonadReduce 4# 39# happyReduction_97 happyReduction_97 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Data) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Family) -> case happyOut89 happy_x_3 of { happy_var_3 -> case happyOut122 happy_x_4 of { happy_var_4 -> ( do { (cs,dh) <- checkDataHeader happy_var_3; let {l = nIS happy_var_1 <++> ann happy_var_3 <+?> (fmap ann) (fst happy_var_4) <** (happy_var_1:happy_var_2:snd happy_var_4)}; return (DataFamDecl l cs dh (fst happy_var_4)) })}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_98 = happyMonadReduce 5# 39# happyReduction_98 happyReduction_98 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Instance) -> case happyOut88 happy_x_3 of { happy_var_3 -> case happyOut104 happy_x_4 of { happy_var_4 -> case happyOut116 happy_x_5 of { happy_var_5 -> ( do { -- (cs,c,t) <- checkDataHeader happy_var_4; checkEnabled TypeFamilies ; let { (qds,ss,minf) = happy_var_4 ; l = happy_var_1 <> happy_var_3 <+?> minf <+?> fmap ann happy_var_5 <** happy_var_2:ss }; checkDataOrNew happy_var_1 qds; return (DataInsDecl l happy_var_1 happy_var_3 (reverse qds) happy_var_5) })}}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_99 = happyMonadReduce 6# 39# happyReduction_99 happyReduction_99 (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) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Instance) -> case happyOut88 happy_x_3 of { happy_var_3 -> case happyOut122 happy_x_4 of { happy_var_4 -> case happyOut100 happy_x_5 of { happy_var_5 -> case happyOut116 happy_x_6 of { happy_var_6 -> ( do { -- (cs,c,t) <- checkDataHeader happy_var_4; checkEnabled TypeFamilies ; let {(gs,ss,minf) = happy_var_5; l = ann happy_var_1 <+?> minf <+?> fmap ann happy_var_6 <** (happy_var_2:snd happy_var_4 ++ ss)}; checkDataOrNewG happy_var_1 gs; return (GDataInsDecl l happy_var_1 happy_var_3 (fst happy_var_4) (reverse gs) happy_var_6) })}}}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_100 = happyMonadReduce 4# 39# happyReduction_100 happyReduction_100 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Class) -> case happyOut89 happy_x_2 of { happy_var_2 -> case happyOut97 happy_x_3 of { happy_var_3 -> case happyOut123 happy_x_4 of { happy_var_4 -> ( do { (cs,dh) <- checkClassHeader happy_var_2; let {(fds,ss1,minf1) = happy_var_3;(mcs,ss2,minf2) = happy_var_4} ; let { l = nIS happy_var_1 <++> ann happy_var_2 <+?> minf1 <+?> minf2 <** (happy_var_1:ss1 ++ ss2)} ; return (ClassDecl l cs dh fds mcs) })}}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_101 = happyMonadReduce 3# 39# happyReduction_101 happyReduction_101 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Instance) -> case happyOut89 happy_x_2 of { happy_var_2 -> case happyOut128 happy_x_3 of { happy_var_3 -> ( do { (cs,ih) <- checkInstHeader happy_var_2; let {(mis,ss,minf) = happy_var_3}; return (InstDecl (nIS happy_var_1 <++> ann happy_var_2 <+?> minf <** (happy_var_1:ss)) cs ih mis) })}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_102 = happyMonadReduce 3# 39# happyReduction_102 happyReduction_102 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Deriving) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Instance) -> case happyOut89 happy_x_3 of { happy_var_3 -> ( do { checkEnabled StandaloneDeriving ; (cs, ih) <- checkInstHeader happy_var_3; let {l = nIS happy_var_1 <++> ann happy_var_3 <** [happy_var_1,happy_var_2]}; return (DerivDecl l cs ih) })}}} ) (\r -> happyReturn (happyIn50 r)) happyReduce_103 = happyReduce 4# 39# happyReduction_103 happyReduction_103 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Default) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOut52 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn50 (DefaultDecl (happy_var_1 <^^> happy_var_4 <** (happy_var_1:happy_var_2 : snd happy_var_3 ++ [happy_var_4])) (fst happy_var_3) ) `HappyStk` happyRest}}}} happyReduce_104 = happyMonadReduce 1# 39# happyReduction_104 happyReduction_104 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut141 happy_x_1 of { happy_var_1 -> ( checkEnabled TemplateHaskell >> checkExpr happy_var_1 >>= \e -> return (SpliceDecl (ann e) e))} ) (\r -> happyReturn (happyIn50 r)) happyReduce_105 = happyReduce 5# 39# happyReduction_105 happyReduction_105 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Foreign) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Import) -> case happyOut63 happy_x_3 of { happy_var_3 -> case happyOut64 happy_x_4 of { happy_var_4 -> case happyOut65 happy_x_5 of { happy_var_5 -> happyIn50 (let (s,n,t,ss) = happy_var_5 in ForImp (nIS happy_var_1 <++> ann t <** (happy_var_1:happy_var_2:ss)) happy_var_3 happy_var_4 s n t ) `HappyStk` happyRest}}}}} happyReduce_106 = happyReduce 4# 39# happyReduction_106 happyReduction_106 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Foreign) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Export) -> case happyOut63 happy_x_3 of { happy_var_3 -> case happyOut65 happy_x_4 of { happy_var_4 -> happyIn50 (let (s,n,t,ss) = happy_var_4 in ForExp (nIS happy_var_1 <++> ann t <** (happy_var_1:happy_var_2:ss)) happy_var_3 s n t ) `HappyStk` happyRest}}}} happyReduce_107 = happySpecReduce_3 39# happyReduction_107 happyReduction_107 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 RULES) -> case happyOut66 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> happyIn50 (RulePragmaDecl (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) $ reverse happy_var_2 )}}} happyReduce_108 = happySpecReduce_3 39# happyReduction_108 happyReduction_108 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 DEPRECATED) -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> happyIn50 (DeprPragmaDecl (happy_var_1 <^^> happy_var_3 <** (happy_var_1:snd happy_var_2++[happy_var_3])) $ reverse (fst happy_var_2) )}}} happyReduce_109 = happySpecReduce_3 39# happyReduction_109 happyReduction_109 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 WARNING) -> case happyOut72 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> happyIn50 (WarnPragmaDecl (happy_var_1 <^^> happy_var_3 <** (happy_var_1:snd happy_var_2++[happy_var_3])) $ reverse (fst happy_var_2) )}}} happyReduce_110 = happySpecReduce_3 39# happyReduction_110 happyReduction_110 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 ANN) -> case happyOut76 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> happyIn50 (AnnPragma (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) happy_var_2 )}}} happyReduce_111 = happySpecReduce_1 39# happyReduction_111 happyReduction_111 happy_x_1 = case happyOut55 happy_x_1 of { happy_var_1 -> happyIn50 (happy_var_1 )} happyReduce_112 = happySpecReduce_1 40# happyReduction_112 happyReduction_112 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Data) -> happyIn51 (DataType $ nIS happy_var_1 )} happyReduce_113 = happySpecReduce_1 40# happyReduction_113 happyReduction_113 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_NewType) -> happyIn51 (NewType $ nIS happy_var_1 )} happyReduce_114 = happyMonadReduce 1# 41# happyReduction_114 happyReduction_114 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut91 happy_x_1 of { happy_var_1 -> ( do { ts <- mapM checkType (fst happy_var_1); return $ (reverse ts, reverse (snd happy_var_1)) })} ) (\r -> happyReturn (happyIn52 r)) happyReduce_115 = happySpecReduce_1 41# happyReduction_115 happyReduction_115 happy_x_1 = case happyOut79 happy_x_1 of { happy_var_1 -> happyIn52 (([happy_var_1],[]) )} happyReduce_116 = happySpecReduce_0 41# happyReduction_116 happyReduction_116 = happyIn52 (([],[]) ) happyReduce_117 = happyMonadReduce 3# 42# happyReduction_117 happyReduction_117 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut54 happy_x_2 of { happy_var_2 -> case happyOut25 happy_x_3 of { happy_var_3 -> ( checkRevDecls (fst happy_var_2) >>= \ds -> return (ds, reverse happy_var_1 ++ snd happy_var_2 ++ reverse happy_var_3))}}} ) (\r -> happyReturn (happyIn53 r)) happyReduce_118 = happySpecReduce_1 42# happyReduction_118 happyReduction_118 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> happyIn53 (([],reverse happy_var_1) )} happyReduce_119 = happySpecReduce_3 43# happyReduction_119 happyReduction_119 happy_x_3 happy_x_2 happy_x_1 = case happyOut54 happy_x_1 of { happy_var_1 -> case happyOut24 happy_x_2 of { happy_var_2 -> case happyOut55 happy_x_3 of { happy_var_3 -> happyIn54 ((happy_var_3 : fst happy_var_1, snd happy_var_1 ++ reverse happy_var_2) )}}} happyReduce_120 = happySpecReduce_1 43# happyReduction_120 happyReduction_120 happy_x_1 = case happyOut55 happy_x_1 of { happy_var_1 -> happyIn54 (([happy_var_1],[]) )} happyReduce_121 = happySpecReduce_1 44# happyReduction_121 happyReduction_121 happy_x_1 = case happyOut57 happy_x_1 of { happy_var_1 -> happyIn55 (happy_var_1 )} happyReduce_122 = happySpecReduce_1 44# happyReduction_122 happyReduction_122 happy_x_1 = case happyOut44 happy_x_1 of { happy_var_1 -> happyIn55 (happy_var_1 )} happyReduce_123 = happySpecReduce_1 44# happyReduction_123 happyReduction_123 happy_x_1 = case happyOut133 happy_x_1 of { happy_var_1 -> happyIn55 (happy_var_1 )} happyReduce_124 = happySpecReduce_3 45# happyReduction_124 happyReduction_124 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftCurly) -> case happyOut53 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightCurly) -> happyIn56 (BDecls (happy_var_1 <^^> happy_var_3 <** (happy_var_1:snd happy_var_2++[happy_var_3])) (fst happy_var_2) )}}} happyReduce_125 = happySpecReduce_3 45# happyReduction_125 happyReduction_125 happy_x_3 happy_x_2 happy_x_1 = case happyOut225 happy_x_1 of { happy_var_1 -> case happyOut53 happy_x_2 of { happy_var_2 -> case happyOut226 happy_x_3 of { happy_var_3 -> happyIn56 (BDecls (happy_var_1 <^^> happy_var_3 <** (happy_var_1:snd happy_var_2++[happy_var_3])) (fst happy_var_2) )}}} happyReduce_126 = happyMonadReduce 3# 46# happyReduction_126 happyReduction_126 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut143 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DoubleColon) -> case happyOut88 happy_x_3 of { happy_var_3 -> ( do { v <- checkSigVar happy_var_1; return $ TypeSig (happy_var_1 <> happy_var_3 <** [happy_var_2]) [v] happy_var_3 })}}} ) (\r -> happyReturn (happyIn57 r)) happyReduce_127 = happyMonadReduce 5# 46# happyReduction_127 happyReduction_127 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut143 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut62 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 DoubleColon) -> case happyOut88 happy_x_5 of { happy_var_5 -> ( do { v <- checkSigVar happy_var_1; let {(vs,ss,_) = happy_var_3 ; l = happy_var_1 <> happy_var_5 <** (happy_var_2 : reverse ss ++ [happy_var_4]) } ; return $ TypeSig l (v : reverse vs) happy_var_5 })}}}}} ) (\r -> happyReturn (happyIn57 r)) happyReduce_128 = happySpecReduce_1 46# happyReduction_128 happyReduction_128 happy_x_1 = case happyOut58 happy_x_1 of { happy_var_1 -> happyIn57 (happy_var_1 )} happyReduce_129 = happyReduce 4# 47# happyReduction_129 happyReduction_129 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut68 happy_x_2 of { happy_var_2 -> case happyOut198 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 PragmaEnd) -> happyIn58 (let Loc l (INLINE s) = happy_var_1 in InlineSig (l <^^> happy_var_4 <** [l,happy_var_4]) s happy_var_2 happy_var_3 ) `HappyStk` happyRest}}}} happyReduce_130 = happyReduce 4# 47# happyReduction_130 happyReduction_130 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 INLINE_CONLIKE) -> case happyOut68 happy_x_2 of { happy_var_2 -> case happyOut198 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 PragmaEnd) -> happyIn58 (InlineConlikeSig (happy_var_1 <^^> happy_var_4 <** [happy_var_1,happy_var_4]) happy_var_2 happy_var_3 ) `HappyStk` happyRest}}}} happyReduce_131 = happyReduce 6# 47# happyReduction_131 happyReduction_131 (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 happyOutTok happy_x_1 of { (Loc happy_var_1 SPECIALISE) -> case happyOut68 happy_x_2 of { happy_var_2 -> case happyOut198 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 DoubleColon) -> case happyOut59 happy_x_5 of { happy_var_5 -> case happyOutTok happy_x_6 of { (Loc happy_var_6 PragmaEnd) -> happyIn58 (SpecSig (happy_var_1 <^^> happy_var_6 <** (happy_var_1: happy_var_4 : snd happy_var_5 ++ [happy_var_6])) happy_var_2 happy_var_3 (fst happy_var_5) ) `HappyStk` happyRest}}}}}} happyReduce_132 = happyReduce 6# 47# happyReduction_132 happyReduction_132 (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 happyOutTok happy_x_1 of { happy_var_1 -> case happyOut68 happy_x_2 of { happy_var_2 -> case happyOut198 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 DoubleColon) -> case happyOut59 happy_x_5 of { happy_var_5 -> case happyOutTok happy_x_6 of { (Loc happy_var_6 PragmaEnd) -> happyIn58 (let Loc l (SPECIALISE_INLINE s) = happy_var_1 in SpecInlineSig (l <^^> happy_var_6 <** (l:happy_var_4:snd happy_var_5++[happy_var_6])) s happy_var_2 happy_var_3 (fst happy_var_5) ) `HappyStk` happyRest}}}}}} happyReduce_133 = happyMonadReduce 4# 47# happyReduction_133 happyReduction_133 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 SPECIALISE) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Instance) -> case happyOut89 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 PragmaEnd) -> ( do { (cs,ih) <- checkInstHeader happy_var_3; let {l = happy_var_1 <^^> happy_var_4 <** [happy_var_1,happy_var_2,happy_var_4]}; return $ InstSig l cs ih })}}}} ) (\r -> happyReturn (happyIn58 r)) happyReduce_134 = happySpecReduce_1 48# happyReduction_134 happyReduction_134 happy_x_1 = case happyOut60 happy_x_1 of { happy_var_1 -> happyIn59 (([happy_var_1],[]) )} happyReduce_135 = happySpecReduce_3 48# happyReduction_135 happyReduction_135 happy_x_3 happy_x_2 happy_x_1 = case happyOut60 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut59 happy_x_3 of { happy_var_3 -> happyIn59 ((happy_var_1 : fst happy_var_3, happy_var_2 : snd happy_var_3) )}}} happyReduce_136 = happyMonadReduce 1# 49# happyReduction_136 happyReduction_136 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut89 happy_x_1 of { happy_var_1 -> ( checkType $ mkTyForall (ann happy_var_1) Nothing Nothing happy_var_1)} ) (\r -> happyReturn (happyIn60 r)) happyReduce_137 = happySpecReduce_1 50# happyReduction_137 happyReduction_137 happy_x_1 = case happyOut56 happy_x_1 of { happy_var_1 -> happyIn61 (happy_var_1 )} happyReduce_138 = happySpecReduce_3 50# happyReduction_138 happyReduction_138 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftCurly) -> case happyOut192 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightCurly) -> happyIn61 (IPBinds (happy_var_1 <^^> happy_var_3 <** snd happy_var_2) (fst happy_var_2) )}}} happyReduce_139 = happySpecReduce_3 50# happyReduction_139 happyReduction_139 happy_x_3 happy_x_2 happy_x_1 = case happyOut225 happy_x_1 of { happy_var_1 -> case happyOut192 happy_x_2 of { happy_var_2 -> case happyOut226 happy_x_3 of { happy_var_3 -> happyIn61 (IPBinds (happy_var_1 <^^> happy_var_3 <** snd happy_var_2) (fst happy_var_2) )}}} happyReduce_140 = happySpecReduce_3 51# happyReduction_140 happyReduction_140 happy_x_3 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut196 happy_x_3 of { happy_var_3 -> happyIn62 (let (ns,ss,l) = happy_var_1 in (happy_var_3 : ns, happy_var_2 : ss, l <++> ann happy_var_3) )}}} happyReduce_141 = happyMonadReduce 1# 51# happyReduction_141 happyReduction_141 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut198 happy_x_1 of { happy_var_1 -> ( do { n <- checkUnQual happy_var_1; return ([n],[],ann n) })} ) (\r -> happyReturn (happyIn62 r)) happyReduce_142 = happySpecReduce_1 52# happyReduction_142 happyReduction_142 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_StdCall) -> happyIn63 (StdCall (nIS happy_var_1) )} happyReduce_143 = happySpecReduce_1 52# happyReduction_143 happyReduction_143 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_CCall) -> happyIn63 (CCall (nIS happy_var_1) )} happyReduce_144 = happySpecReduce_1 52# happyReduction_144 happyReduction_144 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_CPlusPlus) -> happyIn63 (CPlusPlus (nIS happy_var_1) )} happyReduce_145 = happySpecReduce_1 52# happyReduction_145 happyReduction_145 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_DotNet) -> happyIn63 (DotNet (nIS happy_var_1) )} happyReduce_146 = happySpecReduce_1 52# happyReduction_146 happyReduction_146 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Jvm) -> happyIn63 (Jvm (nIS happy_var_1) )} happyReduce_147 = happySpecReduce_1 52# happyReduction_147 happyReduction_147 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Js) -> happyIn63 (Js (nIS happy_var_1) )} happyReduce_148 = happySpecReduce_1 52# happyReduction_148 happyReduction_148 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_CApi) -> happyIn63 (CApi (nIS happy_var_1) )} happyReduce_149 = happySpecReduce_1 53# happyReduction_149 happyReduction_149 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Safe) -> happyIn64 (Just $ PlaySafe (nIS happy_var_1) False )} happyReduce_150 = happySpecReduce_1 53# happyReduction_150 happyReduction_150 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Unsafe) -> happyIn64 (Just $ PlayRisky (nIS happy_var_1) )} happyReduce_151 = happySpecReduce_1 53# happyReduction_151 happyReduction_151 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Threadsafe) -> happyIn64 (Just $ PlaySafe (nIS happy_var_1) True )} happyReduce_152 = happySpecReduce_1 53# happyReduction_152 happyReduction_152 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Interruptible) -> happyIn64 (Just $ PlayInterruptible (nIS happy_var_1) )} happyReduce_153 = happySpecReduce_0 53# happyReduction_153 happyReduction_153 = happyIn64 (Nothing ) happyReduce_154 = happyReduce 4# 54# happyReduction_154 happyReduction_154 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut197 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 DoubleColon) -> case happyOut77 happy_x_4 of { happy_var_4 -> happyIn65 (let Loc l (StringTok (s,_)) = happy_var_1 in (Just s, happy_var_2, happy_var_4, [l,happy_var_3]) ) `HappyStk` happyRest}}}} happyReduce_155 = happySpecReduce_3 54# happyReduction_155 happyReduction_155 happy_x_3 happy_x_2 happy_x_1 = case happyOut197 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DoubleColon) -> case happyOut77 happy_x_3 of { happy_var_3 -> happyIn65 ((Nothing, happy_var_1, happy_var_3, [happy_var_2]) )}}} happyReduce_156 = happySpecReduce_3 55# happyReduction_156 happyReduction_156 happy_x_3 happy_x_2 happy_x_1 = case happyOut66 happy_x_1 of { happy_var_1 -> case happyOut67 happy_x_3 of { happy_var_3 -> happyIn66 (happy_var_3 : happy_var_1 )}} happyReduce_157 = happySpecReduce_2 55# happyReduction_157 happyReduction_157 happy_x_2 happy_x_1 = case happyOut66 happy_x_1 of { happy_var_1 -> happyIn66 (happy_var_1 )} happyReduce_158 = happySpecReduce_1 55# happyReduction_158 happyReduction_158 happy_x_1 = case happyOut67 happy_x_1 of { happy_var_1 -> happyIn66 ([happy_var_1] )} happyReduce_159 = happySpecReduce_0 55# happyReduction_159 happyReduction_159 = happyIn66 ([] ) happyReduce_160 = happyMonadReduce 6# 56# happyReduction_160 happyReduction_160 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut68 happy_x_2 of { happy_var_2 -> case happyOut69 happy_x_3 of { happy_var_3 -> case happyOut141 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 Equals) -> case happyOut139 happy_x_6 of { happy_var_6 -> ( do { let {Loc l (StringTok (s,_)) = happy_var_1}; e <- checkRuleExpr happy_var_4; return $ Rule (nIS l <++> ann happy_var_6 <** l:snd happy_var_3 ++ [happy_var_5]) s happy_var_2 (fst happy_var_3) e happy_var_6 })}}}}}} ) (\r -> happyReturn (happyIn67 r)) happyReduce_161 = happySpecReduce_0 57# happyReduction_161 happyReduction_161 = happyIn68 (Nothing ) happyReduce_162 = happySpecReduce_3 57# happyReduction_162 happyReduction_162 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftSquare) -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightSquare) -> happyIn68 (let Loc l (IntTok (i,_)) = happy_var_2 in Just $ ActiveFrom (happy_var_1 <^^> happy_var_3 <** [happy_var_1,l,happy_var_3]) (fromInteger i) )}}} happyReduce_163 = happyReduce 4# 57# happyReduction_163 happyReduction_163 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftSquare) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Tilde) -> case happyOutTok happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightSquare) -> happyIn68 (let Loc l (IntTok (i,_)) = happy_var_3 in Just $ ActiveUntil (happy_var_1 <^^> happy_var_4 <** [happy_var_1,happy_var_2,l,happy_var_4]) (fromInteger i) ) `HappyStk` happyRest}}}} happyReduce_164 = happySpecReduce_0 58# happyReduction_164 happyReduction_164 = happyIn69 ((Nothing,[]) ) happyReduce_165 = happySpecReduce_3 58# happyReduction_165 happyReduction_165 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Forall) -> case happyOut70 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Dot) -> happyIn69 ((Just happy_var_2,[happy_var_1,happy_var_3]) )}}} happyReduce_166 = happySpecReduce_1 59# happyReduction_166 happyReduction_166 happy_x_1 = case happyOut71 happy_x_1 of { happy_var_1 -> happyIn70 ([happy_var_1] )} happyReduce_167 = happySpecReduce_2 59# happyReduction_167 happyReduction_167 happy_x_2 happy_x_1 = case happyOut71 happy_x_1 of { happy_var_1 -> case happyOut70 happy_x_2 of { happy_var_2 -> happyIn70 (happy_var_1 : happy_var_2 )}} happyReduce_168 = happySpecReduce_1 60# happyReduction_168 happyReduction_168 happy_x_1 = case happyOut213 happy_x_1 of { happy_var_1 -> happyIn71 (RuleVar (ann happy_var_1) happy_var_1 )} happyReduce_169 = happyReduce 5# 60# happyReduction_169 happyReduction_169 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut213 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 DoubleColon) -> case happyOut88 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 RightParen) -> happyIn71 (TypedRuleVar (happy_var_1 <^^> happy_var_5 <** [happy_var_1,happy_var_3,happy_var_5]) happy_var_2 happy_var_4 ) `HappyStk` happyRest}}}}} happyReduce_170 = happySpecReduce_3 61# happyReduction_170 happyReduction_170 happy_x_3 happy_x_2 happy_x_1 = case happyOut72 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 SemiColon) -> case happyOut73 happy_x_3 of { happy_var_3 -> happyIn72 ((fst happy_var_3 : fst happy_var_1, snd happy_var_1 ++ (happy_var_2:snd happy_var_3)) )}}} happyReduce_171 = happySpecReduce_2 61# happyReduction_171 happyReduction_171 happy_x_2 happy_x_1 = case happyOut72 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 SemiColon) -> happyIn72 ((fst happy_var_1, snd happy_var_1 ++ [happy_var_2]) )}} happyReduce_172 = happySpecReduce_1 61# happyReduction_172 happyReduction_172 happy_x_1 = case happyOut73 happy_x_1 of { happy_var_1 -> happyIn72 (([fst happy_var_1],snd happy_var_1) )} happyReduce_173 = happySpecReduce_0 61# happyReduction_173 happyReduction_173 = happyIn72 (([],[]) ) happyReduce_174 = happySpecReduce_2 62# happyReduction_174 happyReduction_174 happy_x_2 happy_x_1 = case happyOut74 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> happyIn73 (let Loc l (StringTok (s,_)) = happy_var_2 in ((fst happy_var_1,s),snd happy_var_1 ++ [l]) )}} happyReduce_175 = happySpecReduce_1 63# happyReduction_175 happyReduction_175 happy_x_1 = case happyOut75 happy_x_1 of { happy_var_1 -> happyIn74 (([happy_var_1],[]) )} happyReduce_176 = happySpecReduce_3 63# happyReduction_176 happyReduction_176 happy_x_3 happy_x_2 happy_x_1 = case happyOut75 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut74 happy_x_3 of { happy_var_3 -> happyIn74 ((happy_var_1 : fst happy_var_3, happy_var_2 : snd happy_var_3) )}}} happyReduce_177 = happySpecReduce_1 64# happyReduction_177 happyReduction_177 happy_x_1 = case happyOut200 happy_x_1 of { happy_var_1 -> happyIn75 (happy_var_1 )} happyReduce_178 = happySpecReduce_1 64# happyReduction_178 happyReduction_178 happy_x_1 = case happyOut196 happy_x_1 of { happy_var_1 -> happyIn75 (happy_var_1 )} happyReduce_179 = happyMonadReduce 3# 65# happyReduction_179 happyReduction_179 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Type) -> case happyOut216 happy_x_2 of { happy_var_2 -> case happyOut152 happy_x_3 of { happy_var_3 -> ( checkExpr happy_var_3 >>= \e -> return (TypeAnn (nIS happy_var_1 <++> ann e <** [happy_var_1]) happy_var_2 e))}}} ) (\r -> happyReturn (happyIn76 r)) happyReduce_180 = happyMonadReduce 2# 65# happyReduction_180 happyReduction_180 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Module) -> case happyOut152 happy_x_2 of { happy_var_2 -> ( checkExpr happy_var_2 >>= \e -> return (ModuleAnn (nIS happy_var_1 <++> ann e <** [happy_var_1]) e))}} ) (\r -> happyReturn (happyIn76 r)) happyReduce_181 = happyMonadReduce 2# 65# happyReduction_181 happyReduction_181 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut75 happy_x_1 of { happy_var_1 -> case happyOut152 happy_x_2 of { happy_var_2 -> ( checkExpr happy_var_2 >>= \e -> return (Ann (happy_var_1 <> e) happy_var_1 e))}} ) (\r -> happyReturn (happyIn76 r)) happyReduce_182 = happyMonadReduce 1# 66# happyReduction_182 happyReduction_182 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut78 happy_x_1 of { happy_var_1 -> ( checkType happy_var_1)} ) (\r -> happyReturn (happyIn77 r)) happyReduce_183 = happySpecReduce_1 67# happyReduction_183 happyReduction_183 happy_x_1 = case happyOut82 happy_x_1 of { happy_var_1 -> happyIn78 (happy_var_1 )} happyReduce_184 = happySpecReduce_3 67# happyReduction_184 happyReduction_184 happy_x_3 happy_x_2 happy_x_1 = case happyOut82 happy_x_1 of { happy_var_1 -> case happyOut87 happy_x_2 of { happy_var_2 -> case happyOut78 happy_x_3 of { happy_var_3 -> happyIn78 (TyInfix (happy_var_1 <> happy_var_3) happy_var_1 happy_var_2 happy_var_3 )}}} happyReduce_185 = happySpecReduce_3 67# happyReduction_185 happyReduction_185 happy_x_3 happy_x_2 happy_x_1 = case happyOut82 happy_x_1 of { happy_var_1 -> case happyOut232 happy_x_2 of { happy_var_2 -> case happyOut78 happy_x_3 of { happy_var_3 -> happyIn78 (TyInfix (happy_var_1 <> happy_var_3) happy_var_1 happy_var_2 happy_var_3 )}}} happyReduce_186 = happySpecReduce_3 67# happyReduction_186 happyReduction_186 happy_x_3 happy_x_2 happy_x_1 = case happyOut82 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightArrow) -> case happyOut89 happy_x_3 of { happy_var_3 -> happyIn78 (TyFun (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_187 = happyMonadReduce 3# 67# happyReduction_187 happyReduction_187 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut82 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Tilde) -> case happyOut82 happy_x_3 of { happy_var_3 -> ( do { checkEnabled TypeFamilies ; let {l = happy_var_1 <> happy_var_3 <** [happy_var_2]}; return $ TyPred l $ EqualP l happy_var_1 happy_var_3 })}}} ) (\r -> happyReturn (happyIn78 r)) happyReduce_188 = happyMonadReduce 1# 68# happyReduction_188 happyReduction_188 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut80 happy_x_1 of { happy_var_1 -> ( checkType happy_var_1)} ) (\r -> happyReturn (happyIn79 r)) happyReduce_189 = happySpecReduce_3 69# happyReduction_189 happyReduction_189 happy_x_3 happy_x_2 happy_x_1 = case happyOut199 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DoubleColon) -> case happyOut78 happy_x_3 of { happy_var_3 -> happyIn80 (let l = (happy_var_1 <> happy_var_3 <** [happy_var_2]) in TyPred l $ IParam l happy_var_1 happy_var_3 )}}} happyReduce_190 = happySpecReduce_1 69# happyReduction_190 happyReduction_190 happy_x_1 = case happyOut78 happy_x_1 of { happy_var_1 -> happyIn80 (happy_var_1 )} happyReduce_191 = happyMonadReduce 1# 70# happyReduction_191 happyReduction_191 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut82 happy_x_1 of { happy_var_1 -> ( checkType happy_var_1)} ) (\r -> happyReturn (happyIn81 r)) happyReduce_192 = happySpecReduce_2 71# happyReduction_192 happyReduction_192 happy_x_2 happy_x_1 = case happyOut82 happy_x_1 of { happy_var_1 -> case happyOut84 happy_x_2 of { happy_var_2 -> happyIn82 (TyApp (happy_var_1 <> happy_var_2) happy_var_1 happy_var_2 )}} happyReduce_193 = happySpecReduce_1 71# happyReduction_193 happyReduction_193 happy_x_1 = case happyOut84 happy_x_1 of { happy_var_1 -> happyIn82 (happy_var_1 )} happyReduce_194 = happyMonadReduce 1# 72# happyReduction_194 happyReduction_194 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut84 happy_x_1 of { happy_var_1 -> ( checkType happy_var_1)} ) (\r -> happyReturn (happyIn83 r)) happyReduce_195 = happySpecReduce_1 73# happyReduction_195 happyReduction_195 happy_x_1 = case happyOut85 happy_x_1 of { happy_var_1 -> happyIn84 (TyCon (ann happy_var_1) happy_var_1 )} happyReduce_196 = happySpecReduce_1 73# happyReduction_196 happyReduction_196 happy_x_1 = case happyOut230 happy_x_1 of { happy_var_1 -> happyIn84 (TyVar (ann happy_var_1) happy_var_1 )} happyReduce_197 = happySpecReduce_3 73# happyReduction_197 happyReduction_197 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut91 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn84 (TyTuple (happy_var_1 <^^> happy_var_3 <** (happy_var_1:reverse (happy_var_3:snd happy_var_2))) Boxed (reverse (fst happy_var_2)) )}}} happyReduce_198 = happySpecReduce_3 73# happyReduction_198 happyReduction_198 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOut92 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightHashParen) -> happyIn84 (TyTuple (happy_var_1 <^^> happy_var_3 <** (happy_var_1:reverse (happy_var_3:snd happy_var_2))) Unboxed (reverse (fst happy_var_2)) )}}} happyReduce_199 = happySpecReduce_3 73# happyReduction_199 happyReduction_199 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftSquare) -> case happyOut80 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightSquare) -> happyIn84 (TyList (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) happy_var_2 )}}} happyReduce_200 = happySpecReduce_3 73# happyReduction_200 happyReduction_200 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut89 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn84 (TyParen (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) happy_var_2 )}}} happyReduce_201 = happyReduce 5# 73# happyReduction_201 happyReduction_201 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut89 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 DoubleColon) -> case happyOut119 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 RightParen) -> happyIn84 (TyKind (happy_var_1 <^^> happy_var_5 <** [happy_var_1,happy_var_3,happy_var_5]) happy_var_2 happy_var_4 ) `HappyStk` happyRest}}}}} happyReduce_202 = happySpecReduce_1 74# happyReduction_202 happyReduction_202 happy_x_1 = case happyOut86 happy_x_1 of { happy_var_1 -> happyIn85 (happy_var_1 )} happyReduce_203 = happySpecReduce_2 74# happyReduction_203 happyReduction_203 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightParen) -> happyIn85 (unit_tycon_name (happy_var_1 <^^> happy_var_2 <** [happy_var_1,happy_var_2]) )}} happyReduce_204 = happySpecReduce_3 74# happyReduction_204 happyReduction_204 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightArrow) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn85 (fun_tycon_name (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_2,happy_var_3]) )}}} happyReduce_205 = happySpecReduce_2 74# happyReduction_205 happyReduction_205 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftSquare) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightSquare) -> happyIn85 (list_tycon_name (happy_var_1 <^^> happy_var_2 <** [happy_var_1,happy_var_2]) )}} happyReduce_206 = happySpecReduce_3 74# happyReduction_206 happyReduction_206 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut155 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn85 (tuple_tycon_name (happy_var_1 <^^> happy_var_3 <** (happy_var_1:reverse happy_var_2 ++ [happy_var_3])) Boxed (length happy_var_2) )}}} happyReduce_207 = happySpecReduce_2 74# happyReduction_207 happyReduction_207 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightHashParen) -> happyIn85 (unboxed_singleton_tycon_name (happy_var_1 <^^> happy_var_2 <** [happy_var_1,happy_var_2]) )}} happyReduce_208 = happySpecReduce_3 74# happyReduction_208 happyReduction_208 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOut155 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightHashParen) -> happyIn85 (tuple_tycon_name (happy_var_1 <^^> happy_var_3 <** (happy_var_1:reverse happy_var_2 ++ [happy_var_3])) Unboxed (length happy_var_2) )}}} happyReduce_209 = happySpecReduce_1 75# happyReduction_209 happyReduction_209 happy_x_1 = case happyOut215 happy_x_1 of { happy_var_1 -> happyIn86 (happy_var_1 )} happyReduce_210 = happySpecReduce_3 75# happyReduction_210 happyReduction_210 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut210 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn86 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_211 = happySpecReduce_3 75# happyReduction_211 happyReduction_211 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut219 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn86 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_212 = happySpecReduce_1 76# happyReduction_212 happyReduction_212 happy_x_1 = case happyOut206 happy_x_1 of { happy_var_1 -> happyIn87 (happy_var_1 )} happyReduce_213 = happyMonadReduce 1# 77# happyReduction_213 happyReduction_213 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut89 happy_x_1 of { happy_var_1 -> ( checkType happy_var_1)} ) (\r -> happyReturn (happyIn88 r)) happyReduce_214 = happyReduce 4# 78# happyReduction_214 happyReduction_214 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Forall) -> case happyOut93 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Dot) -> case happyOut89 happy_x_4 of { happy_var_4 -> happyIn89 (TyForall (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_3]) (Just (reverse (fst happy_var_2))) Nothing happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_215 = happySpecReduce_2 78# happyReduction_215 happyReduction_215 happy_x_2 happy_x_1 = case happyOut90 happy_x_1 of { happy_var_1 -> case happyOut89 happy_x_2 of { happy_var_2 -> happyIn89 (TyForall (happy_var_1 <> happy_var_2) Nothing (Just happy_var_1) happy_var_2 )}} happyReduce_216 = happySpecReduce_1 78# happyReduction_216 happyReduction_216 happy_x_1 = case happyOut80 happy_x_1 of { happy_var_1 -> happyIn89 (happy_var_1 )} happyReduce_217 = happyMonadReduce 2# 79# happyReduction_217 happyReduction_217 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut82 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DoubleArrow) -> ( checkPContext $ (amap (\l -> l <++> nIS happy_var_2 <** (srcInfoPoints l ++ [happy_var_2]))) happy_var_1)}} ) (\r -> happyReturn (happyIn90 r)) happyReduce_218 = happyMonadReduce 4# 79# happyReduction_218 happyReduction_218 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut82 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Tilde) -> case happyOut82 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 DoubleArrow) -> ( do { checkEnabled TypeFamilies; let {l = happy_var_1 <> happy_var_3 <** [happy_var_2,happy_var_4]}; checkPContext (TyPred l $ EqualP l happy_var_1 happy_var_3) })}}}} ) (\r -> happyReturn (happyIn90 r)) happyReduce_219 = happySpecReduce_3 80# happyReduction_219 happyReduction_219 happy_x_3 happy_x_2 happy_x_1 = case happyOut92 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut89 happy_x_3 of { happy_var_3 -> happyIn91 ((happy_var_3 : fst happy_var_1, happy_var_2 : snd happy_var_1) )}}} happyReduce_220 = happySpecReduce_1 81# happyReduction_220 happyReduction_220 happy_x_1 = case happyOut89 happy_x_1 of { happy_var_1 -> happyIn92 (([happy_var_1],[]) )} happyReduce_221 = happySpecReduce_3 81# happyReduction_221 happyReduction_221 happy_x_3 happy_x_2 happy_x_1 = case happyOut92 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut89 happy_x_3 of { happy_var_3 -> happyIn92 ((happy_var_3 : fst happy_var_1, happy_var_2 : snd happy_var_1) )}}} happyReduce_222 = happySpecReduce_2 82# happyReduction_222 happyReduction_222 happy_x_2 happy_x_1 = case happyOut93 happy_x_1 of { happy_var_1 -> case happyOut94 happy_x_2 of { happy_var_2 -> happyIn93 ((happy_var_2 : fst happy_var_1, Just (snd happy_var_1 ann happy_var_2)) )}} happyReduce_223 = happySpecReduce_0 82# happyReduction_223 happyReduction_223 = happyIn93 (([],Nothing) ) happyReduce_224 = happySpecReduce_1 83# happyReduction_224 happyReduction_224 happy_x_1 = case happyOut230 happy_x_1 of { happy_var_1 -> happyIn94 (UnkindedVar (ann happy_var_1) happy_var_1 )} happyReduce_225 = happyReduce 5# 83# happyReduction_225 happyReduction_225 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut230 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 DoubleColon) -> case happyOut119 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 RightParen) -> happyIn94 (KindedVar (happy_var_1 <^^> happy_var_5 <** [happy_var_1,happy_var_3,happy_var_5]) happy_var_2 happy_var_4 ) `HappyStk` happyRest}}}}} happyReduce_226 = happySpecReduce_2 84# happyReduction_226 happyReduction_226 happy_x_2 happy_x_1 = case happyOut95 happy_x_1 of { happy_var_1 -> case happyOut230 happy_x_2 of { happy_var_2 -> happyIn95 ((happy_var_2 : fst happy_var_1, Just (snd happy_var_1 ann happy_var_2)) )}} happyReduce_227 = happySpecReduce_0 84# happyReduction_227 happyReduction_227 = happyIn95 (([], Nothing) ) happyReduce_228 = happySpecReduce_2 85# happyReduction_228 happyReduction_228 happy_x_2 happy_x_1 = case happyOut95 happy_x_1 of { happy_var_1 -> case happyOut230 happy_x_2 of { happy_var_2 -> happyIn96 ((happy_var_2 : fst happy_var_1, snd happy_var_1 ann happy_var_2) )}} happyReduce_229 = happySpecReduce_0 86# happyReduction_229 happyReduction_229 = happyIn97 (([],[], Nothing) ) happyReduce_230 = happyMonadReduce 2# 86# happyReduction_230 happyReduction_230 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 Bar) -> case happyOut98 happy_x_2 of { happy_var_2 -> ( do { checkEnabled FunctionalDependencies ; let {(fds,ss,l) = happy_var_2} ; return (reverse fds, happy_var_1 : reverse ss, Just (nIS happy_var_1 <++> l)) })}} ) (\r -> happyReturn (happyIn97 r)) happyReduce_231 = happySpecReduce_3 87# happyReduction_231 happyReduction_231 happy_x_3 happy_x_2 happy_x_1 = case happyOut98 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut99 happy_x_3 of { happy_var_3 -> happyIn98 (let (fds,ss,l) = happy_var_1 in (happy_var_3 : fds, happy_var_2 : ss, l <++> ann happy_var_3) )}}} happyReduce_232 = happySpecReduce_1 87# happyReduction_232 happyReduction_232 happy_x_1 = case happyOut99 happy_x_1 of { happy_var_1 -> happyIn98 (([happy_var_1],[],ann happy_var_1) )} happyReduce_233 = happySpecReduce_3 88# happyReduction_233 happyReduction_233 happy_x_3 happy_x_2 happy_x_1 = case happyOut95 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightArrow) -> case happyOut96 happy_x_3 of { happy_var_3 -> happyIn99 (FunDep (snd happy_var_1 nIS happy_var_2 <++> snd happy_var_3 <** [happy_var_2]) (reverse (fst happy_var_1)) (reverse (fst happy_var_3)) )}}} happyReduce_234 = happyMonadReduce 4# 89# happyReduction_234 happyReduction_234 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Where) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftCurly) -> case happyOut101 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightCurly) -> ( return (fst happy_var_3, happy_var_1 : happy_var_2 : snd happy_var_3 ++ [happy_var_4], Just $ happy_var_1 <^^> happy_var_4))}}}} ) (\r -> happyReturn (happyIn100 r)) happyReduce_235 = happyMonadReduce 4# 89# happyReduction_235 happyReduction_235 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Where) -> case happyOut225 happy_x_2 of { happy_var_2 -> case happyOut101 happy_x_3 of { happy_var_3 -> case happyOut226 happy_x_4 of { happy_var_4 -> ( return (fst happy_var_3, happy_var_1 : happy_var_2 : snd happy_var_3 ++ [happy_var_4], Just $ happy_var_1 <^^> happy_var_4))}}}} ) (\r -> happyReturn (happyIn100 r)) happyReduce_236 = happyMonadReduce 0# 89# happyReduction_236 happyReduction_236 (happyRest) tk = happyThen (( checkEnabled EmptyDataDecls >> return ([],[],Nothing)) ) (\r -> happyReturn (happyIn100 r)) happyReduce_237 = happySpecReduce_3 90# happyReduction_237 happyReduction_237 happy_x_3 happy_x_2 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut102 happy_x_2 of { happy_var_2 -> case happyOut25 happy_x_3 of { happy_var_3 -> happyIn101 ((fst happy_var_2, reverse happy_var_1 ++ snd happy_var_2 ++ reverse happy_var_3) )}}} happyReduce_238 = happySpecReduce_3 91# happyReduction_238 happyReduction_238 happy_x_3 happy_x_2 happy_x_1 = case happyOut102 happy_x_1 of { happy_var_1 -> case happyOut24 happy_x_2 of { happy_var_2 -> case happyOut103 happy_x_3 of { happy_var_3 -> happyIn102 ((happy_var_3 : fst happy_var_1, snd happy_var_1 ++ reverse happy_var_2) )}}} happyReduce_239 = happySpecReduce_1 91# happyReduction_239 happyReduction_239 happy_x_1 = case happyOut103 happy_x_1 of { happy_var_1 -> happyIn102 (([happy_var_1],[]) )} happyReduce_240 = happyMonadReduce 3# 92# happyReduction_240 happyReduction_240 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut201 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DoubleColon) -> case happyOut88 happy_x_3 of { happy_var_3 -> ( do { c <- checkUnQual happy_var_1; return $ GadtDecl (happy_var_1 <> happy_var_3 <** [happy_var_2]) c happy_var_3 })}}} ) (\r -> happyReturn (happyIn103 r)) happyReduce_241 = happySpecReduce_2 93# happyReduction_241 happyReduction_241 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Equals) -> case happyOut105 happy_x_2 of { happy_var_2 -> happyIn104 (let (ds,ss,l) = happy_var_2 in (ds, happy_var_1 : reverse ss, Just $ nIS happy_var_1 <++> l) )}} happyReduce_242 = happySpecReduce_3 94# happyReduction_242 happyReduction_242 happy_x_3 happy_x_2 happy_x_1 = case happyOut105 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Bar) -> case happyOut106 happy_x_3 of { happy_var_3 -> happyIn105 (let (ds,ss,l) = happy_var_1 in (happy_var_3 : ds, happy_var_2 : ss, l <++> ann happy_var_3) )}}} happyReduce_243 = happySpecReduce_1 94# happyReduction_243 happyReduction_243 happy_x_1 = case happyOut106 happy_x_1 of { happy_var_1 -> happyIn105 (([happy_var_1],[],ann happy_var_1) )} happyReduce_244 = happyMonadReduce 3# 95# happyReduction_244 happyReduction_244 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut107 happy_x_1 of { happy_var_1 -> case happyOut90 happy_x_2 of { happy_var_2 -> case happyOut108 happy_x_3 of { happy_var_3 -> ( do { checkEnabled ExistentialQuantification ; ctxt <- checkContext (Just happy_var_2) ; let {(mtvs,ss,ml) = happy_var_1} ; return $ QualConDecl (ml ann happy_var_3 <** ss) mtvs ctxt happy_var_3 })}}} ) (\r -> happyReturn (happyIn106 r)) happyReduce_245 = happySpecReduce_2 95# happyReduction_245 happyReduction_245 happy_x_2 happy_x_1 = case happyOut107 happy_x_1 of { happy_var_1 -> case happyOut108 happy_x_2 of { happy_var_2 -> happyIn106 (let (mtvs, ss, ml) = happy_var_1 in QualConDecl (ml ann happy_var_2 <** ss) mtvs Nothing happy_var_2 )}} happyReduce_246 = happyMonadReduce 3# 96# happyReduction_246 happyReduction_246 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Forall) -> case happyOut93 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Dot) -> ( checkEnabled ExistentialQuantification >> return (Just (fst happy_var_2), [happy_var_1,happy_var_3], Just $ happy_var_1 <^^> happy_var_3))}}} ) (\r -> happyReturn (happyIn107 r)) happyReduce_247 = happySpecReduce_0 96# happyReduction_247 happyReduction_247 = happyIn107 ((Nothing, [], Nothing) ) happyReduce_248 = happySpecReduce_1 97# happyReduction_248 happyReduction_248 happy_x_1 = case happyOut109 happy_x_1 of { happy_var_1 -> happyIn108 (let (n,ts,l) = happy_var_1 in ConDecl l n ts )} happyReduce_249 = happySpecReduce_3 97# happyReduction_249 happyReduction_249 happy_x_3 happy_x_2 happy_x_1 = case happyOut112 happy_x_1 of { happy_var_1 -> case happyOut205 happy_x_2 of { happy_var_2 -> case happyOut112 happy_x_3 of { happy_var_3 -> happyIn108 (InfixConDecl (happy_var_1 <> happy_var_3) happy_var_1 happy_var_2 happy_var_3 )}}} happyReduce_250 = happyMonadReduce 3# 97# happyReduction_250 happyReduction_250 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut201 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftCurly) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightCurly) -> ( do { c <- checkUnQual happy_var_1; return $ RecDecl (ann happy_var_1 <++> nIS happy_var_3 <** [happy_var_2,happy_var_3]) c [] })}}} ) (\r -> happyReturn (happyIn108 r)) happyReduce_251 = happyMonadReduce 4# 97# happyReduction_251 happyReduction_251 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut201 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftCurly) -> case happyOut113 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightCurly) -> ( do { c <- checkUnQual happy_var_1; return $ RecDecl (ann happy_var_1 <++> nIS happy_var_4 <** (happy_var_2:reverse (snd happy_var_3) ++ [happy_var_4])) c (reverse (fst happy_var_3)) })}}}} ) (\r -> happyReturn (happyIn108 r)) happyReduce_252 = happyMonadReduce 1# 98# happyReduction_252 happyReduction_252 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut82 happy_x_1 of { happy_var_1 -> ( do { (c,ts) <- splitTyConApp happy_var_1; return (c,map (\t -> UnBangedTy (ann t) t) ts,ann happy_var_1) })} ) (\r -> happyReturn (happyIn109 r)) happyReduce_253 = happySpecReduce_1 98# happyReduction_253 happyReduction_253 happy_x_1 = case happyOut110 happy_x_1 of { happy_var_1 -> happyIn109 (happy_var_1 )} happyReduce_254 = happyMonadReduce 3# 99# happyReduction_254 happyReduction_254 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut82 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Exclamation) -> case happyOut83 happy_x_3 of { happy_var_3 -> ( do { (c,ts) <- splitTyConApp happy_var_1; return (c,map (\t -> UnBangedTy (ann t) t) ts++ [BangedTy (nIS happy_var_2 <++> ann happy_var_3 <** [happy_var_2]) happy_var_3], happy_var_1 <> happy_var_3) })}}} ) (\r -> happyReturn (happyIn110 r)) happyReduce_255 = happyMonadReduce 5# 99# happyReduction_255 happyReduction_255 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut82 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 UNPACK) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> case happyOutTok happy_x_4 of { (Loc happy_var_4 Exclamation) -> case happyOut83 happy_x_5 of { happy_var_5 -> ( do { (c,ts) <- splitTyConApp happy_var_1; return (c,map (\t -> UnBangedTy (ann t) t) ts++ [UnpackedTy (nIS happy_var_2 <++> ann happy_var_5 <** [happy_var_2,happy_var_3,happy_var_4]) happy_var_5], happy_var_1 <> happy_var_5) })}}}}} ) (\r -> happyReturn (happyIn110 r)) happyReduce_256 = happySpecReduce_2 99# happyReduction_256 happyReduction_256 happy_x_2 happy_x_1 = case happyOut110 happy_x_1 of { happy_var_1 -> case happyOut111 happy_x_2 of { happy_var_2 -> happyIn110 (let (n,ts,l) = happy_var_1 in (n, ts ++ [happy_var_2],l <++> ann happy_var_2) )}} happyReduce_257 = happySpecReduce_1 100# happyReduction_257 happyReduction_257 happy_x_1 = case happyOut83 happy_x_1 of { happy_var_1 -> happyIn111 (UnBangedTy (ann happy_var_1) happy_var_1 )} happyReduce_258 = happySpecReduce_2 100# happyReduction_258 happyReduction_258 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> case happyOut83 happy_x_2 of { happy_var_2 -> happyIn111 (BangedTy (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_259 = happyReduce 4# 100# happyReduction_259 happyReduction_259 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 UNPACK) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 PragmaEnd) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Exclamation) -> case happyOut83 happy_x_4 of { happy_var_4 -> happyIn111 (UnpackedTy (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_2,happy_var_3]) happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_260 = happySpecReduce_1 101# happyReduction_260 happyReduction_260 happy_x_1 = case happyOut81 happy_x_1 of { happy_var_1 -> happyIn112 (UnBangedTy (ann happy_var_1) happy_var_1 )} happyReduce_261 = happySpecReduce_2 101# happyReduction_261 happyReduction_261 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> case happyOut83 happy_x_2 of { happy_var_2 -> happyIn112 (BangedTy (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_262 = happyReduce 4# 101# happyReduction_262 happyReduction_262 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 UNPACK) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 PragmaEnd) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Exclamation) -> case happyOut83 happy_x_4 of { happy_var_4 -> happyIn112 (UnpackedTy (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_2,happy_var_3]) happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_263 = happySpecReduce_3 102# happyReduction_263 happyReduction_263 happy_x_3 happy_x_2 happy_x_1 = case happyOut113 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut114 happy_x_3 of { happy_var_3 -> happyIn113 ((happy_var_3 : fst happy_var_1, happy_var_2 : snd happy_var_1) )}}} happyReduce_264 = happySpecReduce_1 102# happyReduction_264 happyReduction_264 happy_x_1 = case happyOut114 happy_x_1 of { happy_var_1 -> happyIn113 (([happy_var_1],[]) )} happyReduce_265 = happySpecReduce_3 103# happyReduction_265 happyReduction_265 happy_x_3 happy_x_2 happy_x_1 = case happyOut62 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DoubleColon) -> case happyOut115 happy_x_3 of { happy_var_3 -> happyIn114 (let (ns,ss,l) = happy_var_1 in FieldDecl (l <++> ann happy_var_3 <** (reverse ss ++ [happy_var_2])) (reverse ns) happy_var_3 )}}} happyReduce_266 = happySpecReduce_1 104# happyReduction_266 happyReduction_266 happy_x_1 = case happyOut88 happy_x_1 of { happy_var_1 -> happyIn115 (UnBangedTy (ann happy_var_1) happy_var_1 )} happyReduce_267 = happySpecReduce_2 104# happyReduction_267 happyReduction_267 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> case happyOut83 happy_x_2 of { happy_var_2 -> happyIn115 (BangedTy (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_268 = happyReduce 4# 104# happyReduction_268 happyReduction_268 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 UNPACK) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 PragmaEnd) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Exclamation) -> case happyOut83 happy_x_4 of { happy_var_4 -> happyIn115 (UnpackedTy (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_2,happy_var_3]) happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_269 = happySpecReduce_0 105# happyReduction_269 happyReduction_269 = happyIn116 (Nothing ) happyReduce_270 = happySpecReduce_2 105# happyReduction_270 happyReduction_270 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Deriving) -> case happyOut118 happy_x_2 of { happy_var_2 -> happyIn116 (let l = nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1] in Just $ Deriving l [IHead (ann happy_var_2) happy_var_2 []] )}} happyReduce_271 = happySpecReduce_3 105# happyReduction_271 happyReduction_271 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Deriving) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn116 (Just $ Deriving (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_2,happy_var_3]) [] )}}} happyReduce_272 = happyReduce 4# 105# happyReduction_272 happyReduction_272 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Deriving) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftParen) -> case happyOut117 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn116 (Just $ Deriving (happy_var_1 <^^> happy_var_4 <** happy_var_1:happy_var_2: reverse (snd happy_var_3) ++ [happy_var_4]) (reverse (fst happy_var_3)) ) `HappyStk` happyRest}}}} happyReduce_273 = happyMonadReduce 1# 106# happyReduction_273 happyReduction_273 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut92 happy_x_1 of { happy_var_1 -> ( checkDeriving (fst happy_var_1) >>= \ds -> return (ds, snd happy_var_1))} ) (\r -> happyReturn (happyIn117 r)) happyReduce_274 = happySpecReduce_1 107# happyReduction_274 happyReduction_274 happy_x_1 = case happyOut215 happy_x_1 of { happy_var_1 -> happyIn118 (happy_var_1 )} happyReduce_275 = happyMonadReduce 1# 108# happyReduction_275 happyReduction_275 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut120 happy_x_1 of { happy_var_1 -> ( checkEnabled KindSignatures >> return happy_var_1)} ) (\r -> happyReturn (happyIn119 r)) happyReduce_276 = happySpecReduce_1 109# happyReduction_276 happyReduction_276 happy_x_1 = case happyOut121 happy_x_1 of { happy_var_1 -> happyIn120 (happy_var_1 )} happyReduce_277 = happySpecReduce_3 109# happyReduction_277 happyReduction_277 happy_x_3 happy_x_2 happy_x_1 = case happyOut121 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightArrow) -> case happyOut120 happy_x_3 of { happy_var_3 -> happyIn120 (KindFn (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_278 = happySpecReduce_1 110# happyReduction_278 happyReduction_278 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Star) -> happyIn121 (KindStar (nIS happy_var_1) )} happyReduce_279 = happySpecReduce_1 110# happyReduction_279 happyReduction_279 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> happyIn121 (KindBang (nIS happy_var_1) )} happyReduce_280 = happySpecReduce_3 110# happyReduction_280 happyReduction_280 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut120 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn121 (KindParen (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) happy_var_2 )}}} happyReduce_281 = happySpecReduce_0 111# happyReduction_281 happyReduction_281 = happyIn122 ((Nothing,[]) ) happyReduce_282 = happySpecReduce_2 111# happyReduction_282 happyReduction_282 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 DoubleColon) -> case happyOut119 happy_x_2 of { happy_var_2 -> happyIn122 ((Just happy_var_2,[happy_var_1]) )}} happyReduce_283 = happyMonadReduce 4# 112# happyReduction_283 happyReduction_283 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Where) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftCurly) -> case happyOut124 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightCurly) -> ( checkClassBody (fst happy_var_3) >>= \vs -> return (Just vs, happy_var_1:happy_var_2: snd happy_var_3 ++ [happy_var_4], Just (happy_var_1 <^^> happy_var_4)))}}}} ) (\r -> happyReturn (happyIn123 r)) happyReduce_284 = happyMonadReduce 4# 112# happyReduction_284 happyReduction_284 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Where) -> case happyOut225 happy_x_2 of { happy_var_2 -> case happyOut124 happy_x_3 of { happy_var_3 -> case happyOut226 happy_x_4 of { happy_var_4 -> ( checkClassBody (fst happy_var_3) >>= \vs -> return (Just vs, happy_var_1:happy_var_2: snd happy_var_3 ++ [happy_var_4], Just (happy_var_1 <^^> happy_var_4)))}}}} ) (\r -> happyReturn (happyIn123 r)) happyReduce_285 = happySpecReduce_0 112# happyReduction_285 happyReduction_285 = happyIn123 ((Nothing,[],Nothing) ) happyReduce_286 = happyMonadReduce 3# 113# happyReduction_286 happyReduction_286 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut125 happy_x_2 of { happy_var_2 -> case happyOut25 happy_x_3 of { happy_var_3 -> ( checkRevClsDecls (fst happy_var_2) >>= \cs -> return (cs, reverse happy_var_1 ++ snd happy_var_2 ++ reverse happy_var_3))}}} ) (\r -> happyReturn (happyIn124 r)) happyReduce_287 = happySpecReduce_1 113# happyReduction_287 happyReduction_287 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> happyIn124 (([],reverse happy_var_1) )} happyReduce_288 = happySpecReduce_3 114# happyReduction_288 happyReduction_288 happy_x_3 happy_x_2 happy_x_1 = case happyOut125 happy_x_1 of { happy_var_1 -> case happyOut24 happy_x_2 of { happy_var_2 -> case happyOut126 happy_x_3 of { happy_var_3 -> happyIn125 ((happy_var_3 : fst happy_var_1, snd happy_var_1 ++ reverse happy_var_2) )}}} happyReduce_289 = happySpecReduce_1 114# happyReduction_289 happyReduction_289 happy_x_1 = case happyOut126 happy_x_1 of { happy_var_1 -> happyIn125 (([happy_var_1],[]) )} happyReduce_290 = happySpecReduce_1 115# happyReduction_290 happyReduction_290 happy_x_1 = case happyOut55 happy_x_1 of { happy_var_1 -> happyIn126 (ClsDecl (ann happy_var_1) happy_var_1 )} happyReduce_291 = happyMonadReduce 1# 115# happyReduction_291 happyReduction_291 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut127 happy_x_1 of { happy_var_1 -> ( checkEnabled TypeFamilies >> return happy_var_1)} ) (\r -> happyReturn (happyIn126 r)) happyReduce_292 = happyMonadReduce 3# 116# happyReduction_292 happyReduction_292 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Type) -> case happyOut80 happy_x_2 of { happy_var_2 -> case happyOut122 happy_x_3 of { happy_var_3 -> ( do { dh <- checkSimpleType happy_var_2; return (ClsTyFam (nIS happy_var_1 <++> ann happy_var_2 <+?> (fmap ann) (fst happy_var_3) <** happy_var_1:snd happy_var_3) dh (fst happy_var_3)) })}}} ) (\r -> happyReturn (happyIn127 r)) happyReduce_293 = happyReduce 4# 116# happyReduction_293 happyReduction_293 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Type) -> case happyOut77 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Equals) -> case happyOut88 happy_x_4 of { happy_var_4 -> happyIn127 (ClsTyDef (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_3]) happy_var_2 happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_294 = happyMonadReduce 3# 116# happyReduction_294 happyReduction_294 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Data) -> case happyOut89 happy_x_2 of { happy_var_2 -> case happyOut122 happy_x_3 of { happy_var_3 -> ( do { (cs,dh) <- checkDataHeader happy_var_2; return (ClsDataFam (nIS happy_var_1 <++> ann happy_var_2 <+?> (fmap ann) (fst happy_var_3) <** happy_var_1:snd happy_var_3) cs dh (fst happy_var_3)) })}}} ) (\r -> happyReturn (happyIn127 r)) happyReduce_295 = happyMonadReduce 4# 117# happyReduction_295 happyReduction_295 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Where) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftCurly) -> case happyOut129 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightCurly) -> ( checkInstBody (fst happy_var_3) >>= \vs -> return (Just vs, happy_var_1:happy_var_2: snd happy_var_3 ++ [happy_var_4], Just (happy_var_1 <^^> happy_var_4)))}}}} ) (\r -> happyReturn (happyIn128 r)) happyReduce_296 = happyMonadReduce 4# 117# happyReduction_296 happyReduction_296 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Where) -> case happyOut225 happy_x_2 of { happy_var_2 -> case happyOut129 happy_x_3 of { happy_var_3 -> case happyOut226 happy_x_4 of { happy_var_4 -> ( checkInstBody (fst happy_var_3) >>= \vs -> return (Just vs, happy_var_1:happy_var_2: snd happy_var_3 ++ [happy_var_4], Just (happy_var_1 <^^> happy_var_4)))}}}} ) (\r -> happyReturn (happyIn128 r)) happyReduce_297 = happySpecReduce_0 117# happyReduction_297 happyReduction_297 = happyIn128 ((Nothing, [], Nothing) ) happyReduce_298 = happyMonadReduce 3# 118# happyReduction_298 happyReduction_298 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut130 happy_x_2 of { happy_var_2 -> case happyOut25 happy_x_3 of { happy_var_3 -> ( checkRevInstDecls (fst happy_var_2) >>= \is -> return (is, reverse happy_var_1 ++ snd happy_var_2 ++ reverse happy_var_3))}}} ) (\r -> happyReturn (happyIn129 r)) happyReduce_299 = happySpecReduce_1 118# happyReduction_299 happyReduction_299 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> happyIn129 (([],reverse happy_var_1) )} happyReduce_300 = happySpecReduce_3 119# happyReduction_300 happyReduction_300 happy_x_3 happy_x_2 happy_x_1 = case happyOut130 happy_x_1 of { happy_var_1 -> case happyOut24 happy_x_2 of { happy_var_2 -> case happyOut131 happy_x_3 of { happy_var_3 -> happyIn130 ((happy_var_3 : fst happy_var_1, snd happy_var_1 ++ reverse happy_var_2) )}}} happyReduce_301 = happySpecReduce_1 119# happyReduction_301 happyReduction_301 happy_x_1 = case happyOut131 happy_x_1 of { happy_var_1 -> happyIn130 (([happy_var_1],[]) )} happyReduce_302 = happySpecReduce_1 120# happyReduction_302 happyReduction_302 happy_x_1 = case happyOut133 happy_x_1 of { happy_var_1 -> happyIn131 (InsDecl (ann happy_var_1) happy_var_1 )} happyReduce_303 = happyMonadReduce 1# 120# happyReduction_303 happyReduction_303 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut132 happy_x_1 of { happy_var_1 -> ( checkEnabled TypeFamilies >> return happy_var_1)} ) (\r -> happyReturn (happyIn131 r)) happyReduce_304 = happySpecReduce_1 120# happyReduction_304 happyReduction_304 happy_x_1 = case happyOut58 happy_x_1 of { happy_var_1 -> happyIn131 (InsDecl (ann happy_var_1) happy_var_1 )} happyReduce_305 = happyMonadReduce 4# 121# happyReduction_305 happyReduction_305 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Type) -> case happyOut77 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Equals) -> case happyOut88 happy_x_4 of { happy_var_4 -> ( do { -- no checkSimpleType happy_var_4 since dtype may contain type patterns return (InsType (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_3]) happy_var_2 happy_var_4) })}}}} ) (\r -> happyReturn (happyIn132 r)) happyReduce_306 = happyMonadReduce 4# 121# happyReduction_306 happyReduction_306 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut88 happy_x_2 of { happy_var_2 -> case happyOut104 happy_x_3 of { happy_var_3 -> case happyOut116 happy_x_4 of { happy_var_4 -> ( do { -- (cs,c,t) <- checkDataHeader happy_var_4; let {(ds,ss,minf) = happy_var_3}; checkDataOrNew happy_var_1 ds; return (InsData (happy_var_1 <> happy_var_2 <+?> minf <+?> fmap ann happy_var_4 <** ss ) happy_var_1 happy_var_2 (reverse ds) happy_var_4) })}}}} ) (\r -> happyReturn (happyIn132 r)) happyReduce_307 = happyMonadReduce 5# 121# happyReduction_307 happyReduction_307 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> case happyOut88 happy_x_2 of { happy_var_2 -> case happyOut122 happy_x_3 of { happy_var_3 -> case happyOut100 happy_x_4 of { happy_var_4 -> case happyOut116 happy_x_5 of { happy_var_5 -> ( do { -- (cs,c,t) <- checkDataHeader happy_var_4; let { (gs,ss,minf) = happy_var_4 } ; checkDataOrNewG happy_var_1 gs; return $ InsGData (ann happy_var_1 <+?> minf <+?> fmap ann happy_var_5 <** (snd happy_var_3 ++ ss)) happy_var_1 happy_var_2 (fst happy_var_3) (reverse gs) happy_var_5 })}}}}} ) (\r -> happyReturn (happyIn132 r)) happyReduce_308 = happyMonadReduce 4# 122# happyReduction_308 happyReduction_308 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut143 happy_x_1 of { happy_var_1 -> case happyOut135 happy_x_2 of { happy_var_2 -> case happyOut136 happy_x_3 of { happy_var_3 -> case happyOut134 happy_x_4 of { happy_var_4 -> ( checkValDef ((happy_var_1 <> happy_var_3 <+?> (fmap ann) (fst happy_var_4)) <** (snd happy_var_2 ++ snd happy_var_4)) happy_var_1 (fst happy_var_2) happy_var_3 (fst happy_var_4))}}}} ) (\r -> happyReturn (happyIn133 r)) happyReduce_309 = happyMonadReduce 4# 122# happyReduction_309 happyReduction_309 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> case happyOut152 happy_x_2 of { happy_var_2 -> case happyOut136 happy_x_3 of { happy_var_3 -> case happyOut134 happy_x_4 of { happy_var_4 -> ( do { checkEnabled BangPatterns ; let { l = nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1] }; p <- checkPattern (BangPat l happy_var_2); return $ PatBind (p <> happy_var_3 <+?> (fmap ann) (fst happy_var_4) <** snd happy_var_4) p Nothing happy_var_3 (fst happy_var_4) })}}}} ) (\r -> happyReturn (happyIn133 r)) happyReduce_310 = happySpecReduce_2 123# happyReduction_310 happyReduction_310 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Where) -> case happyOut61 happy_x_2 of { happy_var_2 -> happyIn134 ((Just happy_var_2, [happy_var_1]) )}} happyReduce_311 = happySpecReduce_0 123# happyReduction_311 happyReduction_311 = happyIn134 ((Nothing, []) ) happyReduce_312 = happyMonadReduce 2# 124# happyReduction_312 happyReduction_312 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 DoubleColon) -> case happyOut88 happy_x_2 of { happy_var_2 -> ( checkEnabled ScopedTypeVariables >> return (Just happy_var_2, [happy_var_1]))}} ) (\r -> happyReturn (happyIn135 r)) happyReduce_313 = happySpecReduce_0 124# happyReduction_313 happyReduction_313 = happyIn135 ((Nothing,[]) ) happyReduce_314 = happySpecReduce_2 125# happyReduction_314 happyReduction_314 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Equals) -> case happyOut139 happy_x_2 of { happy_var_2 -> happyIn136 (UnGuardedRhs (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_315 = happySpecReduce_1 125# happyReduction_315 happyReduction_315 happy_x_1 = case happyOut137 happy_x_1 of { happy_var_1 -> happyIn136 (GuardedRhss (snd happy_var_1) (reverse $ fst happy_var_1) )} happyReduce_316 = happySpecReduce_2 126# happyReduction_316 happyReduction_316 happy_x_2 happy_x_1 = case happyOut137 happy_x_1 of { happy_var_1 -> case happyOut138 happy_x_2 of { happy_var_2 -> happyIn137 ((happy_var_2 : fst happy_var_1, snd happy_var_1 <++> ann happy_var_2) )}} happyReduce_317 = happySpecReduce_1 126# happyReduction_317 happyReduction_317 happy_x_1 = case happyOut138 happy_x_1 of { happy_var_1 -> happyIn137 (([happy_var_1],ann happy_var_1) )} happyReduce_318 = happyMonadReduce 4# 127# happyReduction_318 happyReduction_318 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 Bar) -> case happyOut176 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Equals) -> case happyOut139 happy_x_4 of { happy_var_4 -> ( do { checkPatternGuards (fst happy_var_2); return $ GuardedRhs (nIS happy_var_1 <++> ann happy_var_4 <** (happy_var_1:snd happy_var_2 ++ [happy_var_3])) (reverse (fst happy_var_2)) happy_var_4 })}}}} ) (\r -> happyReturn (happyIn138 r)) happyReduce_319 = happyMonadReduce 1# 128# happyReduction_319 happyReduction_319 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut140 happy_x_1 of { happy_var_1 -> ( checkExpr happy_var_1)} ) (\r -> happyReturn (happyIn139 r)) happyReduce_320 = happySpecReduce_3 129# happyReduction_320 happyReduction_320 happy_x_3 happy_x_2 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DoubleColon) -> case happyOut88 happy_x_3 of { happy_var_3 -> happyIn140 (ExpTypeSig (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_321 = happySpecReduce_1 129# happyReduction_321 happyReduction_321 happy_x_1 = case happyOut141 happy_x_1 of { happy_var_1 -> happyIn140 (happy_var_1 )} happyReduce_322 = happySpecReduce_2 129# happyReduction_322 happyReduction_322 happy_x_2 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> case happyOut208 happy_x_2 of { happy_var_2 -> happyIn140 (PostOp (happy_var_1 <> happy_var_2) happy_var_1 happy_var_2 )}} happyReduce_323 = happySpecReduce_3 129# happyReduction_323 happyReduction_323 happy_x_3 happy_x_2 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftArrowTail) -> case happyOut140 happy_x_3 of { happy_var_3 -> happyIn140 (LeftArrApp (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_324 = happySpecReduce_3 129# happyReduction_324 happyReduction_324 happy_x_3 happy_x_2 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightArrowTail) -> case happyOut140 happy_x_3 of { happy_var_3 -> happyIn140 (RightArrApp (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_325 = happySpecReduce_3 129# happyReduction_325 happyReduction_325 happy_x_3 happy_x_2 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftDblArrowTail) -> case happyOut140 happy_x_3 of { happy_var_3 -> happyIn140 (LeftArrHighApp (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_326 = happySpecReduce_3 129# happyReduction_326 happyReduction_326 happy_x_3 happy_x_2 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightDblArrowTail) -> case happyOut140 happy_x_3 of { happy_var_3 -> happyIn140 (RightArrHighApp (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_327 = happySpecReduce_1 130# happyReduction_327 happyReduction_327 happy_x_1 = case happyOut142 happy_x_1 of { happy_var_1 -> happyIn141 (happy_var_1 )} happyReduce_328 = happySpecReduce_1 130# happyReduction_328 happyReduction_328 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> happyIn141 (happy_var_1 )} happyReduce_329 = happySpecReduce_3 131# happyReduction_329 happyReduction_329 happy_x_3 happy_x_2 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> case happyOut208 happy_x_2 of { happy_var_2 -> case happyOut144 happy_x_3 of { happy_var_3 -> happyIn142 (InfixApp (happy_var_1 <> happy_var_3) happy_var_1 happy_var_2 happy_var_3 )}}} happyReduce_330 = happySpecReduce_1 131# happyReduction_330 happyReduction_330 happy_x_1 = case happyOut144 happy_x_1 of { happy_var_1 -> happyIn142 (happy_var_1 )} happyReduce_331 = happySpecReduce_3 132# happyReduction_331 happyReduction_331 happy_x_3 happy_x_2 happy_x_1 = case happyOut143 happy_x_1 of { happy_var_1 -> case happyOut208 happy_x_2 of { happy_var_2 -> case happyOut147 happy_x_3 of { happy_var_3 -> happyIn143 (InfixApp (happy_var_1 <> happy_var_3) happy_var_1 happy_var_2 happy_var_3 )}}} happyReduce_332 = happySpecReduce_1 132# happyReduction_332 happyReduction_332 happy_x_1 = case happyOut147 happy_x_1 of { happy_var_1 -> happyIn143 (happy_var_1 )} happyReduce_333 = happyReduce 4# 133# happyReduction_333 happyReduction_333 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 Backslash) -> case happyOut150 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightArrow) -> case happyOut140 happy_x_4 of { happy_var_4 -> happyIn144 (Lambda (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_3]) (reverse happy_var_2) happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_334 = happyReduce 4# 133# happyReduction_334 happyReduction_334 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Let) -> case happyOut61 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 KW_In) -> case happyOut140 happy_x_4 of { happy_var_4 -> happyIn144 (Let (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_3]) happy_var_2 happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_335 = happyReduce 8# 133# happyReduction_335 happyReduction_335 (happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_If) -> case happyOut140 happy_x_2 of { happy_var_2 -> case happyOut145 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 KW_Then) -> case happyOut140 happy_x_5 of { happy_var_5 -> case happyOut145 happy_x_6 of { happy_var_6 -> case happyOutTok happy_x_7 of { (Loc happy_var_7 KW_Else) -> case happyOut140 happy_x_8 of { happy_var_8 -> happyIn144 (If (nIS happy_var_1 <++> ann happy_var_8 <** (happy_var_1:happy_var_3 ++ happy_var_4:happy_var_6 ++ [happy_var_7])) happy_var_2 happy_var_5 happy_var_8 ) `HappyStk` happyRest}}}}}}}} happyReduce_336 = happyReduce 4# 133# happyReduction_336 happyReduction_336 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Proc) -> case happyOut151 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightArrow) -> case happyOut140 happy_x_4 of { happy_var_4 -> happyIn144 (Proc (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_3]) happy_var_2 happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_337 = happySpecReduce_1 133# happyReduction_337 happyReduction_337 happy_x_1 = case happyOut148 happy_x_1 of { happy_var_1 -> happyIn144 (happy_var_1 )} happyReduce_338 = happyMonadReduce 1# 134# happyReduction_338 happyReduction_338 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 SemiColon) -> ( checkEnabled DoAndIfThenElse >> return [happy_var_1])} ) (\r -> happyReturn (happyIn145 r)) happyReduce_339 = happySpecReduce_0 134# happyReduction_339 happyReduction_339 = happyIn145 ([] ) happyReduce_340 = happySpecReduce_1 135# happyReduction_340 happyReduction_340 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 SemiColon) -> happyIn146 ([happy_var_1] )} happyReduce_341 = happySpecReduce_0 135# happyReduction_341 happyReduction_341 = happyIn146 ([] ) happyReduce_342 = happyReduce 4# 136# happyReduction_342 happyReduction_342 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Case) -> case happyOut140 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 KW_Of) -> case happyOut178 happy_x_4 of { happy_var_4 -> happyIn147 (let (als, inf, ss) = happy_var_4 in Case (nIS happy_var_1 <++> inf <** (happy_var_1:happy_var_3:ss)) happy_var_2 als ) `HappyStk` happyRest}}}} happyReduce_343 = happySpecReduce_2 136# happyReduction_343 happyReduction_343 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Minus) -> case happyOut149 happy_x_2 of { happy_var_2 -> happyIn147 (NegApp (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_344 = happySpecReduce_2 136# happyReduction_344 happyReduction_344 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Do) -> case happyOut186 happy_x_2 of { happy_var_2 -> happyIn147 (let (sts, inf, ss) = happy_var_2 in Do (nIS happy_var_1 <++> inf <** happy_var_1:ss) sts )}} happyReduce_345 = happySpecReduce_2 136# happyReduction_345 happyReduction_345 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_MDo) -> case happyOut186 happy_x_2 of { happy_var_2 -> happyIn147 (let (sts, inf, ss) = happy_var_2 in MDo (nIS happy_var_1 <++> inf <** happy_var_1:ss) sts )}} happyReduce_346 = happySpecReduce_1 136# happyReduction_346 happyReduction_346 happy_x_1 = case happyOut149 happy_x_1 of { happy_var_1 -> happyIn147 (happy_var_1 )} happyReduce_347 = happyReduce 4# 137# happyReduction_347 happyReduction_347 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 CORE) -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> case happyOut140 happy_x_4 of { happy_var_4 -> happyIn148 (let Loc l (StringTok (s,_)) = happy_var_2 in CorePragma (nIS happy_var_1 <++> ann happy_var_4 <** [l,happy_var_3]) s happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_348 = happyReduce 4# 137# happyReduction_348 happyReduction_348 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 SCC) -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 PragmaEnd) -> case happyOut140 happy_x_4 of { happy_var_4 -> happyIn148 (let Loc l (StringTok (s,_)) = happy_var_2 in SCCPragma (nIS happy_var_1 <++> ann happy_var_4 <** [l,happy_var_3]) s happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_349 = happyReduce 11# 137# happyReduction_349 happyReduction_349 (happy_x_11 `HappyStk` happy_x_10 `HappyStk` happy_x_9 `HappyStk` happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 GENERATED) -> case happyOutTok happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 Colon) -> case happyOutTok happy_x_5 of { happy_var_5 -> case happyOutTok happy_x_6 of { (Loc happy_var_6 Minus) -> case happyOutTok happy_x_7 of { happy_var_7 -> case happyOutTok happy_x_8 of { (Loc happy_var_8 Colon) -> case happyOutTok happy_x_9 of { happy_var_9 -> case happyOutTok happy_x_10 of { (Loc happy_var_10 PragmaEnd) -> case happyOut140 happy_x_11 of { happy_var_11 -> happyIn148 (let { Loc l0 (StringTok (s,_)) = happy_var_2; Loc l1 (IntTok (i1,_)) = happy_var_3; Loc l2 (IntTok (i2,_)) = happy_var_5; Loc l3 (IntTok (i3,_)) = happy_var_7; Loc l4 (IntTok (i4,_)) = happy_var_9} in GenPragma (nIS happy_var_1 <++> ann happy_var_11 <** [happy_var_1,l0,l1,happy_var_4,l2,happy_var_6,l3,happy_var_8,l4,happy_var_10]) s (fromInteger i1, fromInteger i2) (fromInteger i3, fromInteger i4) happy_var_11 ) `HappyStk` happyRest}}}}}}}}}}} happyReduce_350 = happySpecReduce_2 138# happyReduction_350 happyReduction_350 happy_x_2 happy_x_1 = case happyOut149 happy_x_1 of { happy_var_1 -> case happyOut152 happy_x_2 of { happy_var_2 -> happyIn149 (App (happy_var_1 <> happy_var_2) happy_var_1 happy_var_2 )}} happyReduce_351 = happySpecReduce_1 138# happyReduction_351 happyReduction_351 happy_x_1 = case happyOut152 happy_x_1 of { happy_var_1 -> happyIn149 (happy_var_1 )} happyReduce_352 = happySpecReduce_2 139# happyReduction_352 happyReduction_352 happy_x_2 happy_x_1 = case happyOut150 happy_x_1 of { happy_var_1 -> case happyOut151 happy_x_2 of { happy_var_2 -> happyIn150 (happy_var_2 : happy_var_1 )}} happyReduce_353 = happySpecReduce_1 139# happyReduction_353 happyReduction_353 happy_x_1 = case happyOut151 happy_x_1 of { happy_var_1 -> happyIn150 ([happy_var_1] )} happyReduce_354 = happyMonadReduce 1# 140# happyReduction_354 happyReduction_354 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut152 happy_x_1 of { happy_var_1 -> ( checkPattern happy_var_1)} ) (\r -> happyReturn (happyIn151 r)) happyReduce_355 = happyMonadReduce 2# 140# happyReduction_355 happyReduction_355 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> case happyOut152 happy_x_2 of { happy_var_2 -> ( checkPattern (BangPat (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2))}} ) (\r -> happyReturn (happyIn151 r)) happyReduce_356 = happyMonadReduce 3# 141# happyReduction_356 happyReduction_356 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut198 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 At) -> case happyOut152 happy_x_3 of { happy_var_3 -> ( do { n <- checkUnQual happy_var_1; return (AsPat (happy_var_1 <> happy_var_3 <** [happy_var_2]) n happy_var_3) })}}} ) (\r -> happyReturn (happyIn152 r)) happyReduce_357 = happyMonadReduce 3# 141# happyReduction_357 happyReduction_357 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut198 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RPCAt) -> case happyOut152 happy_x_3 of { happy_var_3 -> ( do { n <- checkUnQual happy_var_1; return (CAsRP (happy_var_1 <> happy_var_3 <** [happy_var_2]) n happy_var_3) })}}} ) (\r -> happyReturn (happyIn152 r)) happyReduce_358 = happySpecReduce_2 141# happyReduction_358 happyReduction_358 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Tilde) -> case happyOut152 happy_x_2 of { happy_var_2 -> happyIn152 (IrrPat (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_359 = happySpecReduce_1 141# happyReduction_359 happyReduction_359 happy_x_1 = case happyOut153 happy_x_1 of { happy_var_1 -> happyIn152 (happy_var_1 )} happyReduce_360 = happyMonadReduce 3# 142# happyReduction_360 happyReduction_360 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut153 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftCurly) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightCurly) -> ( liftM (amap (const (ann happy_var_1 <++> nIS happy_var_3 <** [happy_var_2,happy_var_3]))) $ mkRecConstrOrUpdate happy_var_1 [])}}} ) (\r -> happyReturn (happyIn153 r)) happyReduce_361 = happyMonadReduce 4# 142# happyReduction_361 happyReduction_361 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut153 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftCurly) -> case happyOut190 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightCurly) -> ( liftM (amap (const (ann happy_var_1 <++> nIS happy_var_4 <** (happy_var_2:reverse (snd happy_var_3) ++ [happy_var_4])))) $ mkRecConstrOrUpdate happy_var_1 (reverse (fst happy_var_3)))}}}} ) (\r -> happyReturn (happyIn153 r)) happyReduce_362 = happyReduce 4# 142# happyReduction_362 happyReduction_362 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut198 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftCurlyBar) -> case happyOut79 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightCurlyBar) -> happyIn153 (ExplTypeArg (ann happy_var_1 <++> nIS happy_var_4 <** [happy_var_2,happy_var_4]) happy_var_1 happy_var_3 ) `HappyStk` happyRest}}}} happyReduce_363 = happySpecReduce_1 142# happyReduction_363 happyReduction_363 happy_x_1 = case happyOut154 happy_x_1 of { happy_var_1 -> happyIn153 (happy_var_1 )} happyReduce_364 = happySpecReduce_1 143# happyReduction_364 happyReduction_364 happy_x_1 = case happyOut199 happy_x_1 of { happy_var_1 -> happyIn154 (IPVar (ann happy_var_1) happy_var_1 )} happyReduce_365 = happySpecReduce_1 143# happyReduction_365 happyReduction_365 happy_x_1 = case happyOut198 happy_x_1 of { happy_var_1 -> happyIn154 (Var (ann happy_var_1) happy_var_1 )} happyReduce_366 = happySpecReduce_1 143# happyReduction_366 happyReduction_366 happy_x_1 = case happyOut195 happy_x_1 of { happy_var_1 -> happyIn154 (happy_var_1 )} happyReduce_367 = happySpecReduce_1 143# happyReduction_367 happyReduction_367 happy_x_1 = case happyOut224 happy_x_1 of { happy_var_1 -> happyIn154 (Lit (ann happy_var_1) happy_var_1 )} happyReduce_368 = happySpecReduce_3 143# happyReduction_368 happyReduction_368 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut156 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn154 (Paren (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) happy_var_2 )}}} happyReduce_369 = happySpecReduce_3 143# happyReduction_369 happyReduction_369 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut156 happy_x_2 of { happy_var_2 -> case happyOut157 happy_x_3 of { happy_var_3 -> happyIn154 (TupleSection (happy_var_1 <^^> head (snd happy_var_3) <** happy_var_1:reverse (snd happy_var_3)) Boxed (Just happy_var_2 : fst happy_var_3) )}}} happyReduce_370 = happyReduce 4# 143# happyReduction_370 happyReduction_370 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut155 happy_x_2 of { happy_var_2 -> case happyOut156 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightParen) -> happyIn154 (TupleSection (happy_var_1 <^^> happy_var_4 <** happy_var_1:reverse (happy_var_4:happy_var_2)) Boxed (replicate (length happy_var_2) Nothing ++ [Just happy_var_3]) ) `HappyStk` happyRest}}}} happyReduce_371 = happyReduce 4# 143# happyReduction_371 happyReduction_371 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut155 happy_x_2 of { happy_var_2 -> case happyOut156 happy_x_3 of { happy_var_3 -> case happyOut157 happy_x_4 of { happy_var_4 -> happyIn154 (TupleSection (happy_var_1 <^^> head (snd happy_var_4) <** happy_var_1:reverse (snd happy_var_4 ++ happy_var_2)) Boxed (replicate (length happy_var_2) Nothing ++ Just happy_var_3 : fst happy_var_4) ) `HappyStk` happyRest}}}} happyReduce_372 = happySpecReduce_3 143# happyReduction_372 happyReduction_372 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOut156 happy_x_2 of { happy_var_2 -> case happyOut158 happy_x_3 of { happy_var_3 -> happyIn154 (TupleSection (happy_var_1 <^^> head (snd happy_var_3) <** happy_var_1:reverse (snd happy_var_3)) Unboxed (Just happy_var_2 : fst happy_var_3) )}}} happyReduce_373 = happySpecReduce_3 143# happyReduction_373 happyReduction_373 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOut156 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightHashParen) -> happyIn154 (TupleSection (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) Unboxed [Just happy_var_2] )}}} happyReduce_374 = happyReduce 4# 143# happyReduction_374 happyReduction_374 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOut155 happy_x_2 of { happy_var_2 -> case happyOut156 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 RightHashParen) -> happyIn154 (TupleSection (happy_var_1 <^^> happy_var_4 <** happy_var_1:reverse (happy_var_4:happy_var_2)) Unboxed (replicate (length happy_var_2) Nothing ++ [Just happy_var_3]) ) `HappyStk` happyRest}}}} happyReduce_375 = happyReduce 4# 143# happyReduction_375 happyReduction_375 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOut155 happy_x_2 of { happy_var_2 -> case happyOut156 happy_x_3 of { happy_var_3 -> case happyOut158 happy_x_4 of { happy_var_4 -> happyIn154 (TupleSection (happy_var_1 <^^> head (snd happy_var_4) <** happy_var_1:reverse (snd happy_var_4 ++ happy_var_2)) Unboxed (replicate (length happy_var_2) Nothing ++ Just happy_var_3 : fst happy_var_4) ) `HappyStk` happyRest}}}} happyReduce_376 = happySpecReduce_3 143# happyReduction_376 happyReduction_376 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftSquare) -> case happyOut170 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightSquare) -> happyIn154 (amap (\l -> l <** [happy_var_3]) $ happy_var_2 (happy_var_1 <^^> happy_var_3 <** [happy_var_1]) )}}} happyReduce_377 = happySpecReduce_1 143# happyReduction_377 happyReduction_377 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Underscore) -> happyIn154 (WildCard (nIS happy_var_1) )} happyReduce_378 = happyMonadReduce 3# 143# happyReduction_378 happyReduction_378 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut160 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> ( checkEnabled RegularPatterns >> return (Paren (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) happy_var_2))}}} ) (\r -> happyReturn (happyIn154 r)) happyReduce_379 = happySpecReduce_3 143# happyReduction_379 happyReduction_379 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 RPGuardOpen) -> case happyOut159 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RPGuardClose) -> happyIn154 (SeqRP (happy_var_1 <^^> happy_var_3 <** (happy_var_1:reverse (snd happy_var_2) ++ [happy_var_3])) $ reverse (fst happy_var_2) )}}} happyReduce_380 = happyReduce 5# 143# happyReduction_380 happyReduction_380 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 RPGuardOpen) -> case happyOut140 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 Bar) -> case happyOut176 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 RPGuardClose) -> happyIn154 (GuardRP (happy_var_1 <^^> happy_var_5 <** (happy_var_1:happy_var_3 : snd happy_var_4 ++ [happy_var_5])) happy_var_2 $ (reverse $ fst happy_var_4) ) `HappyStk` happyRest}}}}} happyReduce_381 = happySpecReduce_1 143# happyReduction_381 happyReduction_381 happy_x_1 = case happyOut161 happy_x_1 of { happy_var_1 -> happyIn154 (happy_var_1 )} happyReduce_382 = happySpecReduce_1 143# happyReduction_382 happyReduction_382 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn154 (let Loc l (THIdEscape s) = happy_var_1 in SpliceExp (nIS l) $ IdSplice (nIS l) s )} happyReduce_383 = happySpecReduce_3 143# happyReduction_383 happyReduction_383 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 THParenEscape) -> case happyOut139 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn154 (SpliceExp (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) $ ParenSplice (ann happy_var_2) happy_var_2 )}}} happyReduce_384 = happySpecReduce_3 143# happyReduction_384 happyReduction_384 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 THExpQuote) -> case happyOut139 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 THCloseQuote) -> happyIn154 (BracketExp (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) $ ExpBracket (ann happy_var_2) happy_var_2 )}}} happyReduce_385 = happyMonadReduce 3# 143# happyReduction_385 happyReduction_385 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 THPatQuote) -> case happyOut141 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 THCloseQuote) -> ( do { p <- checkPattern happy_var_2; return $ BracketExp (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) $ PatBracket (ann p) p })}}} ) (\r -> happyReturn (happyIn154 r)) happyReduce_386 = happySpecReduce_3 143# happyReduction_386 happyReduction_386 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 THTypQuote) -> case happyOut88 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 THCloseQuote) -> happyIn154 (let l = happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3] in BracketExp l $ TypeBracket l happy_var_2 )}}} happyReduce_387 = happyReduce 5# 143# happyReduction_387 happyReduction_387 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 THDecQuote) -> case happyOut48 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 THCloseQuote) -> happyIn154 (let l = happy_var_1 <^^> happy_var_5 <** (happy_var_1:snd happy_var_3 ++ [happy_var_5]) in BracketExp l $ DeclBracket l (fst happy_var_3) ) `HappyStk` happyRest}}} happyReduce_388 = happySpecReduce_2 143# happyReduction_388 happyReduction_388 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 THVarQuote) -> case happyOut198 happy_x_2 of { happy_var_2 -> happyIn154 (VarQuote (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_389 = happySpecReduce_2 143# happyReduction_389 happyReduction_389 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 THVarQuote) -> case happyOut201 happy_x_2 of { happy_var_2 -> happyIn154 (VarQuote (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_390 = happySpecReduce_2 143# happyReduction_390 happyReduction_390 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 THTyQuote) -> case happyOut230 happy_x_2 of { happy_var_2 -> happyIn154 (TypQuote (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) (UnQual (ann happy_var_2) happy_var_2) )}} happyReduce_391 = happySpecReduce_2 143# happyReduction_391 happyReduction_391 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 THTyQuote) -> case happyOut85 happy_x_2 of { happy_var_2 -> happyIn154 (TypQuote (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_392 = happySpecReduce_1 143# happyReduction_392 happyReduction_392 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn154 (let Loc l (THQuasiQuote (n,q)) = happy_var_1 in QuasiQuote (nIS l) n q )} happyReduce_393 = happySpecReduce_2 144# happyReduction_393 happyReduction_393 happy_x_2 happy_x_1 = case happyOut155 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> happyIn155 (happy_var_2 : happy_var_1 )}} happyReduce_394 = happySpecReduce_1 144# happyReduction_394 happyReduction_394 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Comma) -> happyIn155 ([happy_var_1] )} happyReduce_395 = happySpecReduce_1 145# happyReduction_395 happyReduction_395 happy_x_1 = case happyOut140 happy_x_1 of { happy_var_1 -> happyIn156 (happy_var_1 )} happyReduce_396 = happySpecReduce_2 145# happyReduction_396 happyReduction_396 happy_x_2 happy_x_1 = case happyOut209 happy_x_1 of { happy_var_1 -> case happyOut141 happy_x_2 of { happy_var_2 -> happyIn156 (PreOp (happy_var_1 <> happy_var_2) happy_var_1 happy_var_2 )}} happyReduce_397 = happyMonadReduce 3# 145# happyReduction_397 happyReduction_397 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut140 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightArrow) -> case happyOut140 happy_x_3 of { happy_var_3 -> ( do {checkEnabled ViewPatterns; return $ ViewPat (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3})}}} ) (\r -> happyReturn (happyIn156 r)) happyReduce_398 = happySpecReduce_3 146# happyReduction_398 happyReduction_398 happy_x_3 happy_x_2 happy_x_1 = case happyOut155 happy_x_1 of { happy_var_1 -> case happyOut156 happy_x_2 of { happy_var_2 -> case happyOut157 happy_x_3 of { happy_var_3 -> happyIn157 (let (mes, ss) = happy_var_3 in (replicate (length happy_var_1 - 1) Nothing ++ Just happy_var_2 : mes, ss ++ happy_var_1) )}}} happyReduce_399 = happySpecReduce_3 146# happyReduction_399 happyReduction_399 happy_x_3 happy_x_2 happy_x_1 = case happyOut155 happy_x_1 of { happy_var_1 -> case happyOut156 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn157 ((replicate (length happy_var_1 - 1) Nothing ++ [Just happy_var_2], happy_var_3 : happy_var_1) )}}} happyReduce_400 = happySpecReduce_2 146# happyReduction_400 happyReduction_400 happy_x_2 happy_x_1 = case happyOut155 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightParen) -> happyIn157 ((replicate (length happy_var_1) Nothing, happy_var_2 : happy_var_1) )}} happyReduce_401 = happySpecReduce_3 147# happyReduction_401 happyReduction_401 happy_x_3 happy_x_2 happy_x_1 = case happyOut155 happy_x_1 of { happy_var_1 -> case happyOut156 happy_x_2 of { happy_var_2 -> case happyOut158 happy_x_3 of { happy_var_3 -> happyIn158 (let (mes, ss) = happy_var_3 in (replicate (length happy_var_1 - 1) Nothing ++ Just happy_var_2 : mes, ss ++ happy_var_1) )}}} happyReduce_402 = happySpecReduce_3 147# happyReduction_402 happyReduction_402 happy_x_3 happy_x_2 happy_x_1 = case happyOut155 happy_x_1 of { happy_var_1 -> case happyOut156 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightHashParen) -> happyIn158 ((replicate (length happy_var_1 - 1) Nothing ++ [Just happy_var_2], happy_var_3 : happy_var_1) )}}} happyReduce_403 = happySpecReduce_2 147# happyReduction_403 happyReduction_403 happy_x_2 happy_x_1 = case happyOut155 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightHashParen) -> happyIn158 ((replicate (length happy_var_1) Nothing, happy_var_2 : happy_var_1) )}} happyReduce_404 = happySpecReduce_3 148# happyReduction_404 happyReduction_404 happy_x_3 happy_x_2 happy_x_1 = case happyOut159 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut140 happy_x_3 of { happy_var_3 -> happyIn159 ((happy_var_3 : fst happy_var_1, happy_var_2 : snd happy_var_1) )}}} happyReduce_405 = happySpecReduce_1 148# happyReduction_405 happyReduction_405 happy_x_1 = case happyOut140 happy_x_1 of { happy_var_1 -> happyIn159 (([happy_var_1],[]) )} happyReduce_406 = happySpecReduce_3 149# happyReduction_406 happyReduction_406 happy_x_3 happy_x_2 happy_x_1 = case happyOut140 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Bar) -> case happyOut160 happy_x_3 of { happy_var_3 -> happyIn160 (EitherRP (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_407 = happySpecReduce_3 149# happyReduction_407 happyReduction_407 happy_x_3 happy_x_2 happy_x_1 = case happyOut140 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Bar) -> case happyOut140 happy_x_3 of { happy_var_3 -> happyIn160 (EitherRP (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_408 = happyMonadReduce 10# 150# happyReduction_408 happyReduction_408 (happy_x_10 `HappyStk` happy_x_9 `HappyStk` happy_x_8 `HappyStk` happy_x_7 `HappyStk` happy_x_6 `HappyStk` happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 XStdTagOpen) -> case happyOut164 happy_x_2 of { happy_var_2 -> case happyOut167 happy_x_3 of { happy_var_3 -> case happyOut169 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 XStdTagClose) -> case happyOut162 happy_x_6 of { happy_var_6 -> case happyOut146 happy_x_7 of { happy_var_7 -> case happyOutTok happy_x_8 of { (Loc happy_var_8 XCloseTagOpen) -> case happyOut164 happy_x_9 of { happy_var_9 -> case happyOutTok happy_x_10 of { (Loc happy_var_10 XStdTagClose) -> ( do { n <- checkEqNames happy_var_2 happy_var_9; let { cn = reverse happy_var_6; as = reverse happy_var_3; l = happy_var_1 <^^> happy_var_10 <** [happy_var_1,happy_var_5] ++ happy_var_7 ++ [happy_var_8,srcInfoSpan (ann happy_var_9),happy_var_10] }; return $ XTag l n as happy_var_4 cn })}}}}}}}}}} ) (\r -> happyReturn (happyIn161 r)) happyReduce_409 = happyReduce 5# 150# happyReduction_409 happyReduction_409 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 XStdTagOpen) -> case happyOut164 happy_x_2 of { happy_var_2 -> case happyOut167 happy_x_3 of { happy_var_3 -> case happyOut169 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 XEmptyTagClose) -> happyIn161 (XETag (happy_var_1 <^^> happy_var_5 <** [happy_var_1,happy_var_5]) happy_var_2 (reverse happy_var_3) happy_var_4 ) `HappyStk` happyRest}}}}} happyReduce_410 = happySpecReduce_3 150# happyReduction_410 happyReduction_410 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 XCodeTagOpen) -> case happyOut140 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 XCodeTagClose) -> happyIn161 (XExpTag (happy_var_1 <^^> happy_var_3 <** [happy_var_1,happy_var_3]) happy_var_2 )}}} happyReduce_411 = happyReduce 5# 150# happyReduction_411 happyReduction_411 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 XChildTagOpen) -> case happyOut162 happy_x_2 of { happy_var_2 -> case happyOut146 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 XCloseTagOpen) -> case happyOutTok happy_x_5 of { (Loc happy_var_5 XCodeTagClose) -> happyIn161 (XChildTag (happy_var_1 <^^> happy_var_5 <** (happy_var_1:happy_var_3++[happy_var_4,happy_var_5])) (reverse happy_var_2) ) `HappyStk` happyRest}}}}} happyReduce_412 = happySpecReduce_2 151# happyReduction_412 happyReduction_412 happy_x_2 happy_x_1 = case happyOut162 happy_x_1 of { happy_var_1 -> case happyOut163 happy_x_2 of { happy_var_2 -> happyIn162 (happy_var_2 : happy_var_1 )}} happyReduce_413 = happySpecReduce_0 151# happyReduction_413 happyReduction_413 = happyIn162 ([] ) happyReduce_414 = happySpecReduce_1 152# happyReduction_414 happyReduction_414 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn163 (let Loc l (XPCDATA pcd) = happy_var_1 in XPcdata (nIS l) pcd )} happyReduce_415 = happySpecReduce_3 152# happyReduction_415 happyReduction_415 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 XRPatOpen) -> case happyOut159 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 XRPatClose) -> happyIn163 (XRPats (happy_var_1 <^^> happy_var_3 <** (snd happy_var_2 ++ [happy_var_1,happy_var_3])) $ reverse (fst happy_var_2) )}}} happyReduce_416 = happySpecReduce_1 152# happyReduction_416 happyReduction_416 happy_x_1 = case happyOut161 happy_x_1 of { happy_var_1 -> happyIn163 (happy_var_1 )} happyReduce_417 = happySpecReduce_3 153# happyReduction_417 happyReduction_417 happy_x_3 happy_x_2 happy_x_1 = case happyOut165 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Colon) -> case happyOut165 happy_x_3 of { happy_var_3 -> happyIn164 (let {Loc l1 s1 = happy_var_1; Loc l2 s2 = happy_var_3} in XDomName (nIS l1 <++> nIS l2 <** [l1,happy_var_2,l2]) s1 s2 )}}} happyReduce_418 = happySpecReduce_1 153# happyReduction_418 happyReduction_418 happy_x_1 = case happyOut165 happy_x_1 of { happy_var_1 -> happyIn164 (let Loc l str = happy_var_1 in XName (nIS l) str )} happyReduce_419 = happySpecReduce_1 154# happyReduction_419 happyReduction_419 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn165 (let Loc l (VarId s) = happy_var_1 in Loc l s )} happyReduce_420 = happySpecReduce_1 154# happyReduction_420 happyReduction_420 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn165 (let Loc l (ConId s) = happy_var_1 in Loc l s )} happyReduce_421 = happySpecReduce_1 154# happyReduction_421 happyReduction_421 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn165 (let Loc l (DVarId s) = happy_var_1 in Loc l $ mkDVar s )} happyReduce_422 = happySpecReduce_1 154# happyReduction_422 happyReduction_422 happy_x_1 = case happyOut166 happy_x_1 of { happy_var_1 -> happyIn165 (happy_var_1 )} happyReduce_423 = happySpecReduce_1 155# happyReduction_423 happyReduction_423 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Type) -> happyIn166 (Loc happy_var_1 "type" )} happyReduce_424 = happySpecReduce_1 155# happyReduction_424 happyReduction_424 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Class) -> happyIn166 (Loc happy_var_1 "class" )} happyReduce_425 = happySpecReduce_1 155# happyReduction_425 happyReduction_425 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Data) -> happyIn166 (Loc happy_var_1 "data" )} happyReduce_426 = happySpecReduce_1 155# happyReduction_426 happyReduction_426 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Foreign) -> happyIn166 (Loc happy_var_1 "foreign" )} happyReduce_427 = happySpecReduce_1 155# happyReduction_427 happyReduction_427 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Export) -> happyIn166 (Loc happy_var_1 "export" )} happyReduce_428 = happySpecReduce_1 155# happyReduction_428 happyReduction_428 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Safe) -> happyIn166 (Loc happy_var_1 "safe" )} happyReduce_429 = happySpecReduce_1 155# happyReduction_429 happyReduction_429 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Unsafe) -> happyIn166 (Loc happy_var_1 "unsafe" )} happyReduce_430 = happySpecReduce_1 155# happyReduction_430 happyReduction_430 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Threadsafe) -> happyIn166 (Loc happy_var_1 "threadsafe" )} happyReduce_431 = happySpecReduce_1 155# happyReduction_431 happyReduction_431 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_StdCall) -> happyIn166 (Loc happy_var_1 "stdcall" )} happyReduce_432 = happySpecReduce_1 155# happyReduction_432 happyReduction_432 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_CCall) -> happyIn166 (Loc happy_var_1 "ccall" )} happyReduce_433 = happySpecReduce_1 155# happyReduction_433 happyReduction_433 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_CPlusPlus) -> happyIn166 (Loc happy_var_1 "cplusplus" )} happyReduce_434 = happySpecReduce_1 155# happyReduction_434 happyReduction_434 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_DotNet) -> happyIn166 (Loc happy_var_1 "dotnet" )} happyReduce_435 = happySpecReduce_1 155# happyReduction_435 happyReduction_435 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Jvm) -> happyIn166 (Loc happy_var_1 "jvm" )} happyReduce_436 = happySpecReduce_1 155# happyReduction_436 happyReduction_436 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Js) -> happyIn166 (Loc happy_var_1 "js" )} happyReduce_437 = happySpecReduce_1 155# happyReduction_437 happyReduction_437 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_As) -> happyIn166 (Loc happy_var_1 "as" )} happyReduce_438 = happySpecReduce_1 155# happyReduction_438 happyReduction_438 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_By) -> happyIn166 (Loc happy_var_1 "by" )} happyReduce_439 = happySpecReduce_1 155# happyReduction_439 happyReduction_439 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Case) -> happyIn166 (Loc happy_var_1 "case" )} happyReduce_440 = happySpecReduce_1 155# happyReduction_440 happyReduction_440 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Default) -> happyIn166 (Loc happy_var_1 "default" )} happyReduce_441 = happySpecReduce_1 155# happyReduction_441 happyReduction_441 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Deriving) -> happyIn166 (Loc happy_var_1 "deriving" )} happyReduce_442 = happySpecReduce_1 155# happyReduction_442 happyReduction_442 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Do) -> happyIn166 (Loc happy_var_1 "do" )} happyReduce_443 = happySpecReduce_1 155# happyReduction_443 happyReduction_443 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Else) -> happyIn166 (Loc happy_var_1 "else" )} happyReduce_444 = happySpecReduce_1 155# happyReduction_444 happyReduction_444 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Family) -> happyIn166 (Loc happy_var_1 "family" )} happyReduce_445 = happySpecReduce_1 155# happyReduction_445 happyReduction_445 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Forall) -> happyIn166 (Loc happy_var_1 "forall" )} happyReduce_446 = happySpecReduce_1 155# happyReduction_446 happyReduction_446 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Group) -> happyIn166 (Loc happy_var_1 "group" )} happyReduce_447 = happySpecReduce_1 155# happyReduction_447 happyReduction_447 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Hiding) -> happyIn166 (Loc happy_var_1 "hiding" )} happyReduce_448 = happySpecReduce_1 155# happyReduction_448 happyReduction_448 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_If) -> happyIn166 (Loc happy_var_1 "if" )} happyReduce_449 = happySpecReduce_1 155# happyReduction_449 happyReduction_449 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Import) -> happyIn166 (Loc happy_var_1 "import" )} happyReduce_450 = happySpecReduce_1 155# happyReduction_450 happyReduction_450 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_In) -> happyIn166 (Loc happy_var_1 "in" )} happyReduce_451 = happySpecReduce_1 155# happyReduction_451 happyReduction_451 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Infix) -> happyIn166 (Loc happy_var_1 "infix" )} happyReduce_452 = happySpecReduce_1 155# happyReduction_452 happyReduction_452 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_InfixL) -> happyIn166 (Loc happy_var_1 "infixl" )} happyReduce_453 = happySpecReduce_1 155# happyReduction_453 happyReduction_453 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_InfixR) -> happyIn166 (Loc happy_var_1 "infixr" )} happyReduce_454 = happySpecReduce_1 155# happyReduction_454 happyReduction_454 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Instance) -> happyIn166 (Loc happy_var_1 "instance" )} happyReduce_455 = happySpecReduce_1 155# happyReduction_455 happyReduction_455 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Let) -> happyIn166 (Loc happy_var_1 "let" )} happyReduce_456 = happySpecReduce_1 155# happyReduction_456 happyReduction_456 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_MDo) -> happyIn166 (Loc happy_var_1 "mdo" )} happyReduce_457 = happySpecReduce_1 155# happyReduction_457 happyReduction_457 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Module) -> happyIn166 (Loc happy_var_1 "module" )} happyReduce_458 = happySpecReduce_1 155# happyReduction_458 happyReduction_458 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_NewType) -> happyIn166 (Loc happy_var_1 "newtype" )} happyReduce_459 = happySpecReduce_1 155# happyReduction_459 happyReduction_459 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Of) -> happyIn166 (Loc happy_var_1 "of" )} happyReduce_460 = happySpecReduce_1 155# happyReduction_460 happyReduction_460 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Proc) -> happyIn166 (Loc happy_var_1 "proc" )} happyReduce_461 = happySpecReduce_1 155# happyReduction_461 happyReduction_461 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Rec) -> happyIn166 (Loc happy_var_1 "rec" )} happyReduce_462 = happySpecReduce_1 155# happyReduction_462 happyReduction_462 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Then) -> happyIn166 (Loc happy_var_1 "then" )} happyReduce_463 = happySpecReduce_1 155# happyReduction_463 happyReduction_463 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Using) -> happyIn166 (Loc happy_var_1 "using" )} happyReduce_464 = happySpecReduce_1 155# happyReduction_464 happyReduction_464 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Where) -> happyIn166 (Loc happy_var_1 "where" )} happyReduce_465 = happySpecReduce_1 155# happyReduction_465 happyReduction_465 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Qualified) -> happyIn166 (Loc happy_var_1 "qualified" )} happyReduce_466 = happySpecReduce_2 156# happyReduction_466 happyReduction_466 happy_x_2 happy_x_1 = case happyOut167 happy_x_1 of { happy_var_1 -> case happyOut168 happy_x_2 of { happy_var_2 -> happyIn167 (happy_var_2 : happy_var_1 )}} happyReduce_467 = happySpecReduce_0 156# happyReduction_467 happyReduction_467 = happyIn167 ([] ) happyReduce_468 = happySpecReduce_3 157# happyReduction_468 happyReduction_468 happy_x_3 happy_x_2 happy_x_1 = case happyOut164 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Equals) -> case happyOut152 happy_x_3 of { happy_var_3 -> happyIn168 (XAttr (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_469 = happySpecReduce_1 158# happyReduction_469 happyReduction_469 happy_x_1 = case happyOut152 happy_x_1 of { happy_var_1 -> happyIn169 (Just happy_var_1 )} happyReduce_470 = happySpecReduce_0 158# happyReduction_470 happyReduction_470 = happyIn169 (Nothing ) happyReduce_471 = happySpecReduce_1 159# happyReduction_471 happyReduction_471 happy_x_1 = case happyOut156 happy_x_1 of { happy_var_1 -> happyIn170 (\l -> List l [happy_var_1] )} happyReduce_472 = happySpecReduce_1 159# happyReduction_472 happyReduction_472 happy_x_1 = case happyOut171 happy_x_1 of { happy_var_1 -> happyIn170 (\l -> let (ps,ss) = happy_var_1 in List (l <** reverse ss) (reverse ps) )} happyReduce_473 = happySpecReduce_2 159# happyReduction_473 happyReduction_473 happy_x_2 happy_x_1 = case happyOut156 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DotDot) -> happyIn170 (\l -> EnumFrom (l <** [happy_var_2]) happy_var_1 )}} happyReduce_474 = happyReduce 4# 159# happyReduction_474 happyReduction_474 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut156 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut140 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 DotDot) -> happyIn170 (\l -> EnumFromThen (l <** [happy_var_2,happy_var_4]) happy_var_1 happy_var_3 ) `HappyStk` happyRest}}}} happyReduce_475 = happySpecReduce_3 159# happyReduction_475 happyReduction_475 happy_x_3 happy_x_2 happy_x_1 = case happyOut156 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 DotDot) -> case happyOut140 happy_x_3 of { happy_var_3 -> happyIn170 (\l -> EnumFromTo (l <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_476 = happyReduce 5# 159# happyReduction_476 happyReduction_476 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut156 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut140 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_4 of { (Loc happy_var_4 DotDot) -> case happyOut140 happy_x_5 of { happy_var_5 -> happyIn170 (\l -> EnumFromThenTo (l <** [happy_var_2,happy_var_4]) happy_var_1 happy_var_3 happy_var_5 ) `HappyStk` happyRest}}}}} happyReduce_477 = happySpecReduce_3 159# happyReduction_477 happyReduction_477 happy_x_3 happy_x_2 happy_x_1 = case happyOut156 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Bar) -> case happyOut172 happy_x_3 of { happy_var_3 -> happyIn170 (\l -> let (stss, ss) = happy_var_3 in ParComp (l <** (happy_var_2:ss)) happy_var_1 (reverse stss) )}}} happyReduce_478 = happySpecReduce_3 160# happyReduction_478 happyReduction_478 happy_x_3 happy_x_2 happy_x_1 = case happyOut171 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut156 happy_x_3 of { happy_var_3 -> happyIn171 (let (es, ss) = happy_var_1 in (happy_var_3 : es, happy_var_2 : ss) )}}} happyReduce_479 = happySpecReduce_3 160# happyReduction_479 happyReduction_479 happy_x_3 happy_x_2 happy_x_1 = case happyOut156 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut156 happy_x_3 of { happy_var_3 -> happyIn171 (([happy_var_3,happy_var_1], [happy_var_2]) )}}} happyReduce_480 = happySpecReduce_3 161# happyReduction_480 happyReduction_480 happy_x_3 happy_x_2 happy_x_1 = case happyOut172 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Bar) -> case happyOut173 happy_x_3 of { happy_var_3 -> happyIn172 (let { (stss, ss1) = happy_var_1; (sts, ss2) = happy_var_3 } in (reverse sts : stss, ss1 ++ [happy_var_2] ++ reverse ss2) )}}} happyReduce_481 = happySpecReduce_1 161# happyReduction_481 happyReduction_481 happy_x_1 = case happyOut173 happy_x_1 of { happy_var_1 -> happyIn172 (let (sts, ss) = happy_var_1 in ([reverse sts], reverse ss) )} happyReduce_482 = happySpecReduce_3 162# happyReduction_482 happyReduction_482 happy_x_3 happy_x_2 happy_x_1 = case happyOut173 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut174 happy_x_3 of { happy_var_3 -> happyIn173 (let (sts, ss) = happy_var_1 in (happy_var_3 : sts, happy_var_2 : ss) )}}} happyReduce_483 = happySpecReduce_1 162# happyReduction_483 happyReduction_483 happy_x_1 = case happyOut174 happy_x_1 of { happy_var_1 -> happyIn173 (([happy_var_1],[]) )} happyReduce_484 = happySpecReduce_1 163# happyReduction_484 happyReduction_484 happy_x_1 = case happyOut175 happy_x_1 of { happy_var_1 -> happyIn174 (happy_var_1 )} happyReduce_485 = happySpecReduce_1 163# happyReduction_485 happyReduction_485 happy_x_1 = case happyOut177 happy_x_1 of { happy_var_1 -> happyIn174 (QualStmt (ann happy_var_1) happy_var_1 )} happyReduce_486 = happySpecReduce_2 164# happyReduction_486 happyReduction_486 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Then) -> case happyOut139 happy_x_2 of { happy_var_2 -> happyIn175 (ThenTrans (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_487 = happyReduce 4# 164# happyReduction_487 happyReduction_487 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Then) -> case happyOut139 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 KW_By) -> case happyOut139 happy_x_4 of { happy_var_4 -> happyIn175 (ThenBy (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_3]) happy_var_2 happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_488 = happyReduce 4# 164# happyReduction_488 happyReduction_488 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Then) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Group) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 KW_By) -> case happyOut139 happy_x_4 of { happy_var_4 -> happyIn175 (GroupBy (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_2,happy_var_3]) happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_489 = happyReduce 4# 164# happyReduction_489 happyReduction_489 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Then) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Group) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 KW_Using) -> case happyOut139 happy_x_4 of { happy_var_4 -> happyIn175 (GroupUsing (nIS happy_var_1 <++> ann happy_var_4 <** [happy_var_1,happy_var_2,happy_var_3]) happy_var_4 ) `HappyStk` happyRest}}}} happyReduce_490 = happyReduce 6# 164# happyReduction_490 happyReduction_490 (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 happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Then) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 KW_Group) -> case happyOutTok happy_x_3 of { (Loc happy_var_3 KW_By) -> case happyOut139 happy_x_4 of { happy_var_4 -> case happyOutTok happy_x_5 of { (Loc happy_var_5 KW_Using) -> case happyOut139 happy_x_6 of { happy_var_6 -> happyIn175 (GroupByUsing (nIS happy_var_1 <++> ann happy_var_6 <** [happy_var_1,happy_var_2,happy_var_3,happy_var_5]) happy_var_4 happy_var_6 ) `HappyStk` happyRest}}}}}} happyReduce_491 = happySpecReduce_3 165# happyReduction_491 happyReduction_491 happy_x_3 happy_x_2 happy_x_1 = case happyOut176 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut177 happy_x_3 of { happy_var_3 -> happyIn176 (let (sts, ss) = happy_var_1 in (happy_var_3 : sts, happy_var_2 : ss) )}}} happyReduce_492 = happySpecReduce_1 165# happyReduction_492 happyReduction_492 happy_x_1 = case happyOut177 happy_x_1 of { happy_var_1 -> happyIn176 (([happy_var_1],[]) )} happyReduce_493 = happySpecReduce_3 166# happyReduction_493 happyReduction_493 happy_x_3 happy_x_2 happy_x_1 = case happyOut185 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftArrow) -> case happyOut139 happy_x_3 of { happy_var_3 -> happyIn177 (Generator (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_494 = happySpecReduce_1 166# happyReduction_494 happyReduction_494 happy_x_1 = case happyOut139 happy_x_1 of { happy_var_1 -> happyIn177 (Qualifier (ann happy_var_1) happy_var_1 )} happyReduce_495 = happySpecReduce_2 166# happyReduction_495 happyReduction_495 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Let) -> case happyOut61 happy_x_2 of { happy_var_2 -> happyIn177 (LetStmt (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_496 = happySpecReduce_3 167# happyReduction_496 happyReduction_496 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftCurly) -> case happyOut179 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightCurly) -> happyIn178 ((fst happy_var_2, happy_var_1 <^^> happy_var_3, happy_var_1:snd happy_var_2 ++ [happy_var_3]) )}}} happyReduce_497 = happySpecReduce_3 167# happyReduction_497 happyReduction_497 happy_x_3 happy_x_2 happy_x_1 = case happyOut225 happy_x_1 of { happy_var_1 -> case happyOut179 happy_x_2 of { happy_var_2 -> case happyOut226 happy_x_3 of { happy_var_3 -> happyIn178 ((fst happy_var_2, happy_var_1 <^^> happy_var_3, happy_var_1:snd happy_var_2 ++ [happy_var_3]) )}}} happyReduce_498 = happySpecReduce_3 168# happyReduction_498 happyReduction_498 happy_x_3 happy_x_2 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut180 happy_x_2 of { happy_var_2 -> case happyOut25 happy_x_3 of { happy_var_3 -> happyIn179 ((reverse $ fst happy_var_2, happy_var_1 ++ snd happy_var_2 ++ happy_var_3) )}}} happyReduce_499 = happySpecReduce_3 169# happyReduction_499 happyReduction_499 happy_x_3 happy_x_2 happy_x_1 = case happyOut180 happy_x_1 of { happy_var_1 -> case happyOut24 happy_x_2 of { happy_var_2 -> case happyOut181 happy_x_3 of { happy_var_3 -> happyIn180 ((happy_var_3 : fst happy_var_1, snd happy_var_1 ++ happy_var_2) )}}} happyReduce_500 = happySpecReduce_1 169# happyReduction_500 happyReduction_500 happy_x_1 = case happyOut181 happy_x_1 of { happy_var_1 -> happyIn180 (([happy_var_1],[]) )} happyReduce_501 = happySpecReduce_3 170# happyReduction_501 happyReduction_501 happy_x_3 happy_x_2 happy_x_1 = case happyOut185 happy_x_1 of { happy_var_1 -> case happyOut182 happy_x_2 of { happy_var_2 -> case happyOut134 happy_x_3 of { happy_var_3 -> happyIn181 (Alt (happy_var_1 <> happy_var_2 <+?> (fmap ann) (fst happy_var_3) <** snd happy_var_3) happy_var_1 happy_var_2 (fst happy_var_3) )}}} happyReduce_502 = happySpecReduce_2 171# happyReduction_502 happyReduction_502 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 RightArrow) -> case happyOut139 happy_x_2 of { happy_var_2 -> happyIn182 (UnGuardedAlt (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_503 = happySpecReduce_1 171# happyReduction_503 happyReduction_503 happy_x_1 = case happyOut183 happy_x_1 of { happy_var_1 -> happyIn182 (GuardedAlts (snd happy_var_1) (reverse $ fst happy_var_1) )} happyReduce_504 = happySpecReduce_2 172# happyReduction_504 happyReduction_504 happy_x_2 happy_x_1 = case happyOut183 happy_x_1 of { happy_var_1 -> case happyOut184 happy_x_2 of { happy_var_2 -> happyIn183 ((happy_var_2 : fst happy_var_1, snd happy_var_1 <++> ann happy_var_2) )}} happyReduce_505 = happySpecReduce_1 172# happyReduction_505 happyReduction_505 happy_x_1 = case happyOut184 happy_x_1 of { happy_var_1 -> happyIn183 (([happy_var_1], ann happy_var_1) )} happyReduce_506 = happyMonadReduce 4# 173# happyReduction_506 happyReduction_506 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 Bar) -> case happyOut176 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightArrow) -> case happyOut139 happy_x_4 of { happy_var_4 -> ( do { checkPatternGuards (fst happy_var_2); let {l = nIS happy_var_1 <++> ann happy_var_4 <** (happy_var_1:snd happy_var_2 ++ [happy_var_3])}; return (GuardedAlt l (reverse (fst happy_var_2)) happy_var_4) })}}}} ) (\r -> happyReturn (happyIn184 r)) happyReduce_507 = happyMonadReduce 1# 174# happyReduction_507 happyReduction_507 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut140 happy_x_1 of { happy_var_1 -> ( checkPattern happy_var_1)} ) (\r -> happyReturn (happyIn185 r)) happyReduce_508 = happyMonadReduce 2# 174# happyReduction_508 happyReduction_508 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> case happyOut152 happy_x_2 of { happy_var_2 -> ( checkPattern (BangPat (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2))}} ) (\r -> happyReturn (happyIn185 r)) happyReduce_509 = happySpecReduce_3 175# happyReduction_509 happyReduction_509 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftCurly) -> case happyOut187 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightCurly) -> happyIn186 ((fst happy_var_2, happy_var_1 <^^> happy_var_3, happy_var_1:snd happy_var_2 ++ [happy_var_3]) )}}} happyReduce_510 = happySpecReduce_3 175# happyReduction_510 happyReduction_510 happy_x_3 happy_x_2 happy_x_1 = case happyOut225 happy_x_1 of { happy_var_1 -> case happyOut187 happy_x_2 of { happy_var_2 -> case happyOut226 happy_x_3 of { happy_var_3 -> happyIn186 ((fst happy_var_2, happy_var_1 <^^> happy_var_3, happy_var_1:snd happy_var_2 ++ [happy_var_3]) )}}} happyReduce_511 = happySpecReduce_2 176# happyReduction_511 happyReduction_511 happy_x_2 happy_x_1 = case happyOut189 happy_x_1 of { happy_var_1 -> case happyOut188 happy_x_2 of { happy_var_2 -> happyIn187 ((happy_var_1 : fst happy_var_2, snd happy_var_2) )}} happyReduce_512 = happySpecReduce_2 176# happyReduction_512 happyReduction_512 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 SemiColon) -> case happyOut187 happy_x_2 of { happy_var_2 -> happyIn187 ((fst happy_var_2, happy_var_1 : snd happy_var_2) )}} happyReduce_513 = happySpecReduce_0 176# happyReduction_513 happyReduction_513 = happyIn187 (([],[]) ) happyReduce_514 = happySpecReduce_2 177# happyReduction_514 happyReduction_514 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 SemiColon) -> case happyOut187 happy_x_2 of { happy_var_2 -> happyIn188 ((fst happy_var_2, happy_var_1 : snd happy_var_2) )}} happyReduce_515 = happySpecReduce_0 177# happyReduction_515 happyReduction_515 = happyIn188 (([],[]) ) happyReduce_516 = happySpecReduce_2 178# happyReduction_516 happyReduction_516 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Let) -> case happyOut61 happy_x_2 of { happy_var_2 -> happyIn189 (LetStmt (nIS happy_var_1 <++> ann happy_var_2 <** [happy_var_1]) happy_var_2 )}} happyReduce_517 = happySpecReduce_3 178# happyReduction_517 happyReduction_517 happy_x_3 happy_x_2 happy_x_1 = case happyOut185 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 LeftArrow) -> case happyOut139 happy_x_3 of { happy_var_3 -> happyIn189 (Generator (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_518 = happySpecReduce_1 178# happyReduction_518 happyReduction_518 happy_x_1 = case happyOut139 happy_x_1 of { happy_var_1 -> happyIn189 (Qualifier (ann happy_var_1) happy_var_1 )} happyReduce_519 = happySpecReduce_2 178# happyReduction_519 happyReduction_519 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Rec) -> case happyOut186 happy_x_2 of { happy_var_2 -> happyIn189 (let (stms,inf,ss) = happy_var_2 in RecStmt (nIS happy_var_1 <++> inf <** happy_var_1:ss) stms )}} happyReduce_520 = happySpecReduce_3 179# happyReduction_520 happyReduction_520 happy_x_3 happy_x_2 happy_x_1 = case happyOut190 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Comma) -> case happyOut191 happy_x_3 of { happy_var_3 -> happyIn190 (let (fbs, ss) = happy_var_1 in (happy_var_3 : fbs, happy_var_2 : ss) )}}} happyReduce_521 = happySpecReduce_1 179# happyReduction_521 happyReduction_521 happy_x_1 = case happyOut191 happy_x_1 of { happy_var_1 -> happyIn190 (([happy_var_1],[]) )} happyReduce_522 = happySpecReduce_3 180# happyReduction_522 happyReduction_522 happy_x_3 happy_x_2 happy_x_1 = case happyOut198 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Equals) -> case happyOut140 happy_x_3 of { happy_var_3 -> happyIn191 (FieldUpdate (happy_var_1 <>happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_523 = happyMonadReduce 1# 180# happyReduction_523 happyReduction_523 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut198 happy_x_1 of { happy_var_1 -> ( checkEnabled NamedFieldPuns >> checkUnQual happy_var_1 >>= return . FieldPun (ann happy_var_1))} ) (\r -> happyReturn (happyIn191 r)) happyReduce_524 = happyMonadReduce 1# 180# happyReduction_524 happyReduction_524 (happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOutTok happy_x_1 of { (Loc happy_var_1 DotDot) -> ( checkEnabled RecordWildCards >> return (FieldWildcard (nIS happy_var_1)))} ) (\r -> happyReturn (happyIn191 r)) happyReduce_525 = happySpecReduce_3 181# happyReduction_525 happyReduction_525 happy_x_3 happy_x_2 happy_x_1 = case happyOut25 happy_x_1 of { happy_var_1 -> case happyOut193 happy_x_2 of { happy_var_2 -> case happyOut25 happy_x_3 of { happy_var_3 -> happyIn192 ((reverse (fst happy_var_2), reverse happy_var_1 ++ snd happy_var_2 ++ reverse happy_var_3) )}}} happyReduce_526 = happySpecReduce_3 182# happyReduction_526 happyReduction_526 happy_x_3 happy_x_2 happy_x_1 = case happyOut193 happy_x_1 of { happy_var_1 -> case happyOut24 happy_x_2 of { happy_var_2 -> case happyOut194 happy_x_3 of { happy_var_3 -> happyIn193 ((happy_var_3 : fst happy_var_1, snd happy_var_1 ++ reverse happy_var_2) )}}} happyReduce_527 = happySpecReduce_1 182# happyReduction_527 happyReduction_527 happy_x_1 = case happyOut194 happy_x_1 of { happy_var_1 -> happyIn193 (([happy_var_1],[]) )} happyReduce_528 = happySpecReduce_3 183# happyReduction_528 happyReduction_528 happy_x_3 happy_x_2 happy_x_1 = case happyOut199 happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { (Loc happy_var_2 Equals) -> case happyOut139 happy_x_3 of { happy_var_3 -> happyIn194 (IPBind (happy_var_1 <> happy_var_3 <** [happy_var_2]) happy_var_1 happy_var_3 )}}} happyReduce_529 = happySpecReduce_2 184# happyReduction_529 happyReduction_529 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightParen) -> happyIn195 (p_unit_con (happy_var_1 <^^> happy_var_2 <** [happy_var_1,happy_var_2]) )}} happyReduce_530 = happySpecReduce_2 184# happyReduction_530 happyReduction_530 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftSquare) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightSquare) -> happyIn195 (List (happy_var_1 <^^> happy_var_2 <** [happy_var_1,happy_var_2]) [] )}} happyReduce_531 = happySpecReduce_3 184# happyReduction_531 happyReduction_531 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut155 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn195 (p_tuple_con (happy_var_1 <^^> happy_var_3 <** happy_var_1:reverse (happy_var_3:happy_var_2)) Boxed (length happy_var_2) )}}} happyReduce_532 = happySpecReduce_2 184# happyReduction_532 happyReduction_532 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOutTok happy_x_2 of { (Loc happy_var_2 RightHashParen) -> happyIn195 (p_unboxed_singleton_con (happy_var_1 <^^> happy_var_2 <** [happy_var_1,happy_var_2]) )}} happyReduce_533 = happySpecReduce_3 184# happyReduction_533 happyReduction_533 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftHashParen) -> case happyOut155 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightHashParen) -> happyIn195 (p_tuple_con (happy_var_1 <^^> happy_var_3 <** happy_var_1:reverse (happy_var_3:happy_var_2)) Unboxed (length happy_var_2) )}}} happyReduce_534 = happySpecReduce_1 184# happyReduction_534 happyReduction_534 happy_x_1 = case happyOut201 happy_x_1 of { happy_var_1 -> happyIn195 (Con (ann happy_var_1) happy_var_1 )} happyReduce_535 = happySpecReduce_1 185# happyReduction_535 happyReduction_535 happy_x_1 = case happyOut213 happy_x_1 of { happy_var_1 -> happyIn196 (happy_var_1 )} happyReduce_536 = happySpecReduce_3 185# happyReduction_536 happyReduction_536 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut221 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn196 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_537 = happySpecReduce_1 186# happyReduction_537 happyReduction_537 happy_x_1 = case happyOut212 happy_x_1 of { happy_var_1 -> happyIn197 (happy_var_1 )} happyReduce_538 = happySpecReduce_3 186# happyReduction_538 happyReduction_538 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut221 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn197 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_539 = happySpecReduce_1 187# happyReduction_539 happyReduction_539 happy_x_1 = case happyOut211 happy_x_1 of { happy_var_1 -> happyIn198 (happy_var_1 )} happyReduce_540 = happySpecReduce_3 187# happyReduction_540 happyReduction_540 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut219 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn198 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_541 = happySpecReduce_1 188# happyReduction_541 happyReduction_541 happy_x_1 = case happyOut214 happy_x_1 of { happy_var_1 -> happyIn199 (happy_var_1 )} happyReduce_542 = happySpecReduce_1 189# happyReduction_542 happyReduction_542 happy_x_1 = case happyOut216 happy_x_1 of { happy_var_1 -> happyIn200 (happy_var_1 )} happyReduce_543 = happySpecReduce_3 189# happyReduction_543 happyReduction_543 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut218 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn200 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_544 = happySpecReduce_1 190# happyReduction_544 happyReduction_544 happy_x_1 = case happyOut215 happy_x_1 of { happy_var_1 -> happyIn201 (happy_var_1 )} happyReduce_545 = happySpecReduce_3 190# happyReduction_545 happyReduction_545 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 LeftParen) -> case happyOut210 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 RightParen) -> happyIn201 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_546 = happySpecReduce_1 191# happyReduction_546 happyReduction_546 happy_x_1 = case happyOut221 happy_x_1 of { happy_var_1 -> happyIn202 (happy_var_1 )} happyReduce_547 = happySpecReduce_3 191# happyReduction_547 happyReduction_547 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 BackQuote) -> case happyOut213 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 BackQuote) -> happyIn202 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_548 = happySpecReduce_1 192# happyReduction_548 happyReduction_548 happy_x_1 = case happyOut219 happy_x_1 of { happy_var_1 -> happyIn203 (happy_var_1 )} happyReduce_549 = happySpecReduce_3 192# happyReduction_549 happyReduction_549 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 BackQuote) -> case happyOut211 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 BackQuote) -> happyIn203 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_550 = happySpecReduce_1 193# happyReduction_550 happyReduction_550 happy_x_1 = case happyOut220 happy_x_1 of { happy_var_1 -> happyIn204 (happy_var_1 )} happyReduce_551 = happySpecReduce_3 193# happyReduction_551 happyReduction_551 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 BackQuote) -> case happyOut211 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 BackQuote) -> happyIn204 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_552 = happySpecReduce_1 194# happyReduction_552 happyReduction_552 happy_x_1 = case happyOut218 happy_x_1 of { happy_var_1 -> happyIn205 (happy_var_1 )} happyReduce_553 = happySpecReduce_3 194# happyReduction_553 happyReduction_553 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 BackQuote) -> case happyOut216 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 BackQuote) -> happyIn205 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_554 = happySpecReduce_1 195# happyReduction_554 happyReduction_554 happy_x_1 = case happyOut210 happy_x_1 of { happy_var_1 -> happyIn206 (happy_var_1 )} happyReduce_555 = happySpecReduce_3 195# happyReduction_555 happyReduction_555 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 BackQuote) -> case happyOut215 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 BackQuote) -> happyIn206 (fmap (const (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3])) happy_var_2 )}}} happyReduce_556 = happySpecReduce_1 196# happyReduction_556 happyReduction_556 happy_x_1 = case happyOut202 happy_x_1 of { happy_var_1 -> happyIn207 (VarOp (ann happy_var_1) happy_var_1 )} happyReduce_557 = happySpecReduce_1 196# happyReduction_557 happyReduction_557 happy_x_1 = case happyOut205 happy_x_1 of { happy_var_1 -> happyIn207 (ConOp (ann happy_var_1) happy_var_1 )} happyReduce_558 = happySpecReduce_1 197# happyReduction_558 happyReduction_558 happy_x_1 = case happyOut203 happy_x_1 of { happy_var_1 -> happyIn208 (QVarOp (ann happy_var_1) happy_var_1 )} happyReduce_559 = happySpecReduce_1 197# happyReduction_559 happyReduction_559 happy_x_1 = case happyOut206 happy_x_1 of { happy_var_1 -> happyIn208 (QConOp (ann happy_var_1) happy_var_1 )} happyReduce_560 = happySpecReduce_1 198# happyReduction_560 happyReduction_560 happy_x_1 = case happyOut204 happy_x_1 of { happy_var_1 -> happyIn209 (QVarOp (ann happy_var_1) happy_var_1 )} happyReduce_561 = happySpecReduce_1 198# happyReduction_561 happyReduction_561 happy_x_1 = case happyOut206 happy_x_1 of { happy_var_1 -> happyIn209 (QConOp (ann happy_var_1) happy_var_1 )} happyReduce_562 = happySpecReduce_1 199# happyReduction_562 happyReduction_562 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Colon) -> happyIn210 (list_cons_name (nIS happy_var_1) )} happyReduce_563 = happySpecReduce_1 199# happyReduction_563 happyReduction_563 happy_x_1 = case happyOut217 happy_x_1 of { happy_var_1 -> happyIn210 (happy_var_1 )} happyReduce_564 = happySpecReduce_1 200# happyReduction_564 happyReduction_564 happy_x_1 = case happyOut213 happy_x_1 of { happy_var_1 -> happyIn211 (UnQual (ann happy_var_1) happy_var_1 )} happyReduce_565 = happySpecReduce_1 200# happyReduction_565 happyReduction_565 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn211 (let {Loc l (QVarId q) = happy_var_1; nis = nIS l} in Qual nis (ModuleName nis (fst q)) (Ident nis (snd q)) )} happyReduce_566 = happySpecReduce_1 201# happyReduction_566 happyReduction_566 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn212 (let Loc l (VarId v) = happy_var_1 in Ident (nIS l) v )} happyReduce_567 = happySpecReduce_1 201# happyReduction_567 happyReduction_567 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_As) -> happyIn212 (as_name (nIS happy_var_1) )} happyReduce_568 = happySpecReduce_1 201# happyReduction_568 happyReduction_568 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Qualified) -> happyIn212 (qualified_name (nIS happy_var_1) )} happyReduce_569 = happySpecReduce_1 201# happyReduction_569 happyReduction_569 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Hiding) -> happyIn212 (hiding_name (nIS happy_var_1) )} happyReduce_570 = happySpecReduce_1 201# happyReduction_570 happyReduction_570 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Export) -> happyIn212 (export_name (nIS happy_var_1) )} happyReduce_571 = happySpecReduce_1 201# happyReduction_571 happyReduction_571 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_StdCall) -> happyIn212 (stdcall_name (nIS happy_var_1) )} happyReduce_572 = happySpecReduce_1 201# happyReduction_572 happyReduction_572 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_CCall) -> happyIn212 (ccall_name (nIS happy_var_1) )} happyReduce_573 = happySpecReduce_1 201# happyReduction_573 happyReduction_573 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_CPlusPlus) -> happyIn212 (cplusplus_name (nIS happy_var_1) )} happyReduce_574 = happySpecReduce_1 201# happyReduction_574 happyReduction_574 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_DotNet) -> happyIn212 (dotnet_name (nIS happy_var_1) )} happyReduce_575 = happySpecReduce_1 201# happyReduction_575 happyReduction_575 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Jvm) -> happyIn212 (jvm_name (nIS happy_var_1) )} happyReduce_576 = happySpecReduce_1 201# happyReduction_576 happyReduction_576 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Js) -> happyIn212 (js_name (nIS happy_var_1) )} happyReduce_577 = happySpecReduce_1 202# happyReduction_577 happyReduction_577 happy_x_1 = case happyOut212 happy_x_1 of { happy_var_1 -> happyIn213 (happy_var_1 )} happyReduce_578 = happySpecReduce_1 202# happyReduction_578 happyReduction_578 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Safe) -> happyIn213 (safe_name (nIS happy_var_1) )} happyReduce_579 = happySpecReduce_1 202# happyReduction_579 happyReduction_579 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Unsafe) -> happyIn213 (unsafe_name (nIS happy_var_1) )} happyReduce_580 = happySpecReduce_1 202# happyReduction_580 happyReduction_580 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Threadsafe) -> happyIn213 (threadsafe_name (nIS happy_var_1) )} happyReduce_581 = happySpecReduce_1 202# happyReduction_581 happyReduction_581 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Forall) -> happyIn213 (forall_name (nIS happy_var_1) )} happyReduce_582 = happySpecReduce_1 202# happyReduction_582 happyReduction_582 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Family) -> happyIn213 (family_name (nIS happy_var_1) )} happyReduce_583 = happySpecReduce_1 203# happyReduction_583 happyReduction_583 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn214 (let Loc l (IDupVarId i) = happy_var_1 in IPDup (nIS l) i )} happyReduce_584 = happySpecReduce_1 203# happyReduction_584 happyReduction_584 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn214 (let Loc l (ILinVarId i) = happy_var_1 in IPLin (nIS l) i )} happyReduce_585 = happySpecReduce_1 204# happyReduction_585 happyReduction_585 happy_x_1 = case happyOut216 happy_x_1 of { happy_var_1 -> happyIn215 (UnQual (ann happy_var_1) happy_var_1 )} happyReduce_586 = happySpecReduce_1 204# happyReduction_586 happyReduction_586 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn215 (let {Loc l (QConId q) = happy_var_1; nis = nIS l} in Qual nis (ModuleName nis (fst q)) (Ident nis (snd q)) )} happyReduce_587 = happySpecReduce_1 205# happyReduction_587 happyReduction_587 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn216 (let Loc l (ConId c) = happy_var_1 in Ident (nIS l) c )} happyReduce_588 = happySpecReduce_1 206# happyReduction_588 happyReduction_588 happy_x_1 = case happyOut218 happy_x_1 of { happy_var_1 -> happyIn217 (UnQual (ann happy_var_1) happy_var_1 )} happyReduce_589 = happySpecReduce_1 206# happyReduction_589 happyReduction_589 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn217 (let {Loc l (QConSym q) = happy_var_1; nis = nIS l} in Qual nis (ModuleName nis (fst q)) (Symbol nis (snd q)) )} happyReduce_590 = happySpecReduce_1 207# happyReduction_590 happyReduction_590 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn218 (let Loc l (ConSym c) = happy_var_1 in Symbol (nIS l) c )} happyReduce_591 = happySpecReduce_1 208# happyReduction_591 happyReduction_591 happy_x_1 = case happyOut221 happy_x_1 of { happy_var_1 -> happyIn219 (UnQual (ann happy_var_1) happy_var_1 )} happyReduce_592 = happySpecReduce_1 208# happyReduction_592 happyReduction_592 happy_x_1 = case happyOut223 happy_x_1 of { happy_var_1 -> happyIn219 (happy_var_1 )} happyReduce_593 = happySpecReduce_1 209# happyReduction_593 happyReduction_593 happy_x_1 = case happyOut222 happy_x_1 of { happy_var_1 -> happyIn220 (UnQual (ann happy_var_1) happy_var_1 )} happyReduce_594 = happySpecReduce_1 209# happyReduction_594 happyReduction_594 happy_x_1 = case happyOut223 happy_x_1 of { happy_var_1 -> happyIn220 (happy_var_1 )} happyReduce_595 = happySpecReduce_1 210# happyReduction_595 happyReduction_595 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn221 (let Loc l (VarSym v) = happy_var_1 in Symbol (nIS l) v )} happyReduce_596 = happySpecReduce_1 210# happyReduction_596 happyReduction_596 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Minus) -> happyIn221 (minus_name (nIS happy_var_1) )} happyReduce_597 = happySpecReduce_1 210# happyReduction_597 happyReduction_597 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> happyIn221 (bang_name (nIS happy_var_1) )} happyReduce_598 = happySpecReduce_1 210# happyReduction_598 happyReduction_598 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Dot) -> happyIn221 (dot_name (nIS happy_var_1) )} happyReduce_599 = happySpecReduce_1 210# happyReduction_599 happyReduction_599 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Star) -> happyIn221 (star_name (nIS happy_var_1) )} happyReduce_600 = happySpecReduce_1 211# happyReduction_600 happyReduction_600 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn222 (let Loc l (VarSym v) = happy_var_1 in Symbol (nIS l) v )} happyReduce_601 = happySpecReduce_1 211# happyReduction_601 happyReduction_601 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Exclamation) -> happyIn222 (bang_name (nIS happy_var_1) )} happyReduce_602 = happySpecReduce_1 211# happyReduction_602 happyReduction_602 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Dot) -> happyIn222 (dot_name (nIS happy_var_1) )} happyReduce_603 = happySpecReduce_1 211# happyReduction_603 happyReduction_603 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 Star) -> happyIn222 (star_name (nIS happy_var_1) )} happyReduce_604 = happySpecReduce_1 212# happyReduction_604 happyReduction_604 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn223 (let {Loc l (QVarSym q) = happy_var_1; nis = nIS l} in Qual nis (ModuleName nis (fst q)) (Symbol nis (snd q)) )} happyReduce_605 = happySpecReduce_1 213# happyReduction_605 happyReduction_605 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (IntTok (i,raw)) = happy_var_1 in Int (nIS l) i raw )} happyReduce_606 = happySpecReduce_1 213# happyReduction_606 happyReduction_606 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (Character (c,raw)) = happy_var_1 in Char (nIS l) c raw )} happyReduce_607 = happySpecReduce_1 213# happyReduction_607 happyReduction_607 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (FloatTok (r,raw)) = happy_var_1 in Frac (nIS l) r raw )} happyReduce_608 = happySpecReduce_1 213# happyReduction_608 happyReduction_608 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (StringTok (s,raw)) = happy_var_1 in String (nIS l) s raw )} happyReduce_609 = happySpecReduce_1 213# happyReduction_609 happyReduction_609 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (IntTokHash (i,raw)) = happy_var_1 in PrimInt (nIS l) i raw )} happyReduce_610 = happySpecReduce_1 213# happyReduction_610 happyReduction_610 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (WordTokHash (w,raw)) = happy_var_1 in PrimWord (nIS l) w raw )} happyReduce_611 = happySpecReduce_1 213# happyReduction_611 happyReduction_611 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (FloatTokHash (f,raw)) = happy_var_1 in PrimFloat (nIS l) f raw )} happyReduce_612 = happySpecReduce_1 213# happyReduction_612 happyReduction_612 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (DoubleTokHash (d,raw)) = happy_var_1 in PrimDouble (nIS l) d raw )} happyReduce_613 = happySpecReduce_1 213# happyReduction_613 happyReduction_613 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (CharacterHash (c,raw)) = happy_var_1 in PrimChar (nIS l) c raw )} happyReduce_614 = happySpecReduce_1 213# happyReduction_614 happyReduction_614 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn224 (let Loc l (StringHash (s,raw)) = happy_var_1 in PrimString (nIS l) s raw )} happyReduce_615 = happyMonadReduce 0# 214# happyReduction_615 happyReduction_615 (happyRest) tk = happyThen (( pushCurrentContext >> getSrcLoc >>= \s -> return $ mkSrcSpan s s {- >>= \x -> trace (show x) (return x) -}) ) (\r -> happyReturn (happyIn225 r)) happyReduce_616 = happySpecReduce_1 215# happyReduction_616 happyReduction_616 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 VRightCurly) -> happyIn226 (happy_var_1 {- >>= \x -> trace (show x ++ show x ++ show x) (return x) -} )} happyReduce_617 = happyMonadReduce 1# 215# happyReduction_617 happyReduction_617 (happy_x_1 `HappyStk` happyRest) tk = happyThen (( popContext >> getSrcLoc >>= \s -> return $ mkSrcSpan s s {- >>= \x -> trace (show x ++ show x) (return x) -}) ) (\r -> happyReturn (happyIn226 r)) happyReduce_618 = happySpecReduce_1 216# happyReduction_618 happyReduction_618 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn227 (let Loc l (ConId n) = happy_var_1 in ModuleName (nIS l) n )} happyReduce_619 = happySpecReduce_1 216# happyReduction_619 happyReduction_619 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn227 (let Loc l (QConId n) = happy_var_1 in ModuleName (nIS l) (fst n ++ '.':snd n) )} happyReduce_620 = happySpecReduce_1 217# happyReduction_620 happyReduction_620 happy_x_1 = case happyOut200 happy_x_1 of { happy_var_1 -> happyIn228 (happy_var_1 )} happyReduce_621 = happySpecReduce_1 218# happyReduction_621 happyReduction_621 happy_x_1 = case happyOut201 happy_x_1 of { happy_var_1 -> happyIn229 (happy_var_1 )} happyReduce_622 = happySpecReduce_1 219# happyReduction_622 happyReduction_622 happy_x_1 = case happyOut231 happy_x_1 of { happy_var_1 -> happyIn230 (happy_var_1 )} happyReduce_623 = happySpecReduce_1 220# happyReduction_623 happyReduction_623 happy_x_1 = case happyOut212 happy_x_1 of { happy_var_1 -> happyIn231 (happy_var_1 )} happyReduce_624 = happySpecReduce_1 220# happyReduction_624 happyReduction_624 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Safe) -> happyIn231 (safe_name (nIS happy_var_1) )} happyReduce_625 = happySpecReduce_1 220# happyReduction_625 happyReduction_625 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Unsafe) -> happyIn231 (unsafe_name (nIS happy_var_1) )} happyReduce_626 = happySpecReduce_1 220# happyReduction_626 happyReduction_626 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 KW_Threadsafe) -> happyIn231 (threadsafe_name (nIS happy_var_1) )} happyReduce_627 = happySpecReduce_3 221# happyReduction_627 happyReduction_627 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { (Loc happy_var_1 BackQuote) -> case happyOut230 happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { (Loc happy_var_3 BackQuote) -> happyIn232 (UnQual (happy_var_1 <^^> happy_var_3 <** [happy_var_1, srcInfoSpan (ann happy_var_2), happy_var_3]) happy_var_2 )}}} happyReduce_628 = happySpecReduce_1 221# happyReduction_628 happyReduction_628 happy_x_1 = case happyOut233 happy_x_1 of { happy_var_1 -> happyIn232 (UnQual (ann happy_var_1) happy_var_1 )} happyReduce_629 = happySpecReduce_1 222# happyReduction_629 happyReduction_629 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn233 (let Loc l (VarSym x) = happy_var_1 in Symbol (nIS l) x )} happyNewToken action sts stk = lexer(\tk -> let cont i = happyDoAction i tk action sts stk in case tk of { Loc _ EOF -> happyDoAction 140# tk action sts stk; Loc _ (VarId _) -> cont 1#; Loc _ (QVarId _) -> cont 2#; Loc _ (IDupVarId _) -> cont 3#; Loc _ (ILinVarId _) -> cont 4#; Loc _ (ConId _) -> cont 5#; Loc _ (QConId _) -> cont 6#; Loc _ (DVarId _) -> cont 7#; Loc _ (VarSym _) -> cont 8#; Loc _ (ConSym _) -> cont 9#; Loc _ (QVarSym _) -> cont 10#; Loc _ (QConSym _) -> cont 11#; Loc _ (IntTok _) -> cont 12#; Loc _ (FloatTok _) -> cont 13#; Loc _ (Character _) -> cont 14#; Loc _ (StringTok _) -> cont 15#; Loc _ (IntTokHash _) -> cont 16#; Loc _ (WordTokHash _) -> cont 17#; Loc _ (FloatTokHash _) -> cont 18#; Loc _ (DoubleTokHash _) -> cont 19#; Loc _ (CharacterHash _) -> cont 20#; Loc _ (StringHash _) -> cont 21#; Loc happy_dollar_dollar LeftParen -> cont 22#; Loc happy_dollar_dollar RightParen -> cont 23#; Loc happy_dollar_dollar LeftHashParen -> cont 24#; Loc happy_dollar_dollar RightHashParen -> cont 25#; Loc happy_dollar_dollar LeftCurlyBar -> cont 26#; Loc happy_dollar_dollar RightCurlyBar -> cont 27#; Loc happy_dollar_dollar SemiColon -> cont 28#; Loc happy_dollar_dollar LeftCurly -> cont 29#; Loc happy_dollar_dollar RightCurly -> cont 30#; Loc happy_dollar_dollar VRightCurly -> cont 31#; Loc happy_dollar_dollar LeftSquare -> cont 32#; Loc happy_dollar_dollar RightSquare -> cont 33#; Loc happy_dollar_dollar Comma -> cont 34#; Loc happy_dollar_dollar Underscore -> cont 35#; Loc happy_dollar_dollar BackQuote -> cont 36#; Loc happy_dollar_dollar Dot -> cont 37#; Loc happy_dollar_dollar DotDot -> cont 38#; Loc happy_dollar_dollar Colon -> cont 39#; Loc happy_dollar_dollar DoubleColon -> cont 40#; Loc happy_dollar_dollar Equals -> cont 41#; Loc happy_dollar_dollar Backslash -> cont 42#; Loc happy_dollar_dollar Bar -> cont 43#; Loc happy_dollar_dollar LeftArrow -> cont 44#; Loc happy_dollar_dollar RightArrow -> cont 45#; Loc happy_dollar_dollar At -> cont 46#; Loc happy_dollar_dollar Tilde -> cont 47#; Loc happy_dollar_dollar DoubleArrow -> cont 48#; Loc happy_dollar_dollar Minus -> cont 49#; Loc happy_dollar_dollar Exclamation -> cont 50#; Loc happy_dollar_dollar Star -> cont 51#; Loc happy_dollar_dollar LeftArrowTail -> cont 52#; Loc happy_dollar_dollar RightArrowTail -> cont 53#; Loc happy_dollar_dollar LeftDblArrowTail -> cont 54#; Loc happy_dollar_dollar RightDblArrowTail -> cont 55#; Loc happy_dollar_dollar RPGuardOpen -> cont 56#; Loc happy_dollar_dollar RPGuardClose -> cont 57#; Loc happy_dollar_dollar RPCAt -> cont 58#; Loc _ (THIdEscape _) -> cont 59#; Loc happy_dollar_dollar THParenEscape -> cont 60#; Loc happy_dollar_dollar THExpQuote -> cont 61#; Loc happy_dollar_dollar THPatQuote -> cont 62#; Loc happy_dollar_dollar THTypQuote -> cont 63#; Loc happy_dollar_dollar THDecQuote -> cont 64#; Loc happy_dollar_dollar THCloseQuote -> cont 65#; Loc happy_dollar_dollar THVarQuote -> cont 66#; Loc happy_dollar_dollar THTyQuote -> cont 67#; Loc _ (THQuasiQuote _) -> cont 68#; Loc _ (XPCDATA _) -> cont 69#; Loc happy_dollar_dollar XStdTagOpen -> cont 70#; Loc happy_dollar_dollar XCloseTagOpen -> cont 71#; Loc happy_dollar_dollar XCodeTagOpen -> cont 72#; Loc happy_dollar_dollar XChildTagOpen -> cont 73#; Loc happy_dollar_dollar XStdTagClose -> cont 74#; Loc happy_dollar_dollar XEmptyTagClose -> cont 75#; Loc happy_dollar_dollar XCodeTagClose -> cont 76#; Loc happy_dollar_dollar XRPatOpen -> cont 77#; Loc happy_dollar_dollar XRPatClose -> cont 78#; Loc happy_dollar_dollar KW_Foreign -> cont 79#; Loc happy_dollar_dollar KW_Export -> cont 80#; Loc happy_dollar_dollar KW_Safe -> cont 81#; Loc happy_dollar_dollar KW_Unsafe -> cont 82#; Loc happy_dollar_dollar KW_Threadsafe -> cont 83#; Loc happy_dollar_dollar KW_Interruptible -> cont 84#; Loc happy_dollar_dollar KW_StdCall -> cont 85#; Loc happy_dollar_dollar KW_CCall -> cont 86#; Loc happy_dollar_dollar KW_CPlusPlus -> cont 87#; Loc happy_dollar_dollar KW_DotNet -> cont 88#; Loc happy_dollar_dollar KW_Jvm -> cont 89#; Loc happy_dollar_dollar KW_Js -> cont 90#; Loc happy_dollar_dollar KW_CApi -> cont 91#; Loc happy_dollar_dollar KW_As -> cont 92#; Loc happy_dollar_dollar KW_By -> cont 93#; Loc happy_dollar_dollar KW_Case -> cont 94#; Loc happy_dollar_dollar KW_Class -> cont 95#; Loc happy_dollar_dollar KW_Data -> cont 96#; Loc happy_dollar_dollar KW_Default -> cont 97#; Loc happy_dollar_dollar KW_Deriving -> cont 98#; Loc happy_dollar_dollar KW_Do -> cont 99#; Loc happy_dollar_dollar KW_Else -> cont 100#; Loc happy_dollar_dollar KW_Family -> cont 101#; Loc happy_dollar_dollar KW_Forall -> cont 102#; Loc happy_dollar_dollar KW_Group -> cont 103#; Loc happy_dollar_dollar KW_Hiding -> cont 104#; Loc happy_dollar_dollar KW_If -> cont 105#; Loc happy_dollar_dollar KW_Import -> cont 106#; Loc happy_dollar_dollar KW_In -> cont 107#; Loc happy_dollar_dollar KW_Infix -> cont 108#; Loc happy_dollar_dollar KW_InfixL -> cont 109#; Loc happy_dollar_dollar KW_InfixR -> cont 110#; Loc happy_dollar_dollar KW_Instance -> cont 111#; Loc happy_dollar_dollar KW_Let -> cont 112#; Loc happy_dollar_dollar KW_MDo -> cont 113#; Loc happy_dollar_dollar KW_Module -> cont 114#; Loc happy_dollar_dollar KW_NewType -> cont 115#; Loc happy_dollar_dollar KW_Of -> cont 116#; Loc happy_dollar_dollar KW_Proc -> cont 117#; Loc happy_dollar_dollar KW_Rec -> cont 118#; Loc happy_dollar_dollar KW_Then -> cont 119#; Loc happy_dollar_dollar KW_Type -> cont 120#; Loc happy_dollar_dollar KW_Using -> cont 121#; Loc happy_dollar_dollar KW_Where -> cont 122#; Loc happy_dollar_dollar KW_Qualified -> cont 123#; Loc _ (INLINE _) -> cont 124#; Loc happy_dollar_dollar INLINE_CONLIKE -> cont 125#; Loc happy_dollar_dollar SPECIALISE -> cont 126#; Loc _ (SPECIALISE_INLINE _) -> cont 127#; Loc happy_dollar_dollar SOURCE -> cont 128#; Loc happy_dollar_dollar RULES -> cont 129#; Loc happy_dollar_dollar CORE -> cont 130#; Loc happy_dollar_dollar SCC -> cont 131#; Loc happy_dollar_dollar GENERATED -> cont 132#; Loc happy_dollar_dollar DEPRECATED -> cont 133#; Loc happy_dollar_dollar WARNING -> cont 134#; Loc happy_dollar_dollar UNPACK -> cont 135#; Loc _ (OPTIONS _) -> cont 136#; Loc happy_dollar_dollar LANGUAGE -> cont 137#; Loc happy_dollar_dollar ANN -> cont 138#; Loc happy_dollar_dollar PragmaEnd -> cont 139#; _ -> happyError' tk }) happyError_ 140# tk = happyError' tk happyError_ _ tk = happyError' tk happyThen :: () => P a -> (a -> P b) -> P b happyThen = (>>=) happyReturn :: () => a -> P a happyReturn = (return) happyThen1 = happyThen happyReturn1 :: () => a -> P a happyReturn1 = happyReturn happyError' :: () => (Loc Token) -> P a happyError' tk = parseError tk mparseModule = happySomeParser where happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut13 x)) mparseExp = happySomeParser where happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut139 x)) mparsePat = happySomeParser where happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut185 x)) mparseDecl = happySomeParser where happySomeParser = happyThen (happyParse 3#) (\x -> happyReturn (happyOut50 x)) mparseType = happySomeParser where happySomeParser = happyThen (happyParse 4#) (\x -> happyReturn (happyOut88 x)) mparseStmt = happySomeParser where happySomeParser = happyThen (happyParse 5#) (\x -> happyReturn (happyOut189 x)) mparseModules = happySomeParser where happySomeParser = happyThen (happyParse 6#) (\x -> happyReturn (happyOut11 x)) mfindOptPragmas = happySomeParser where happySomeParser = happyThen (happyParse 7#) (\x -> happyReturn (happyOut15 x)) happySeq = happyDontSeq type L = SrcSpanInfo -- just for convenience type S = SrcSpan parseError :: Loc Token -> P a parseError t = fail $ "Parse error: " ++ showToken (unLoc t) (<>) :: (Annotated a, Annotated b) => a SrcSpanInfo -> b SrcSpanInfo -> SrcSpanInfo a <> b = ann a <++> ann b infixl 6 <> nIS = noInfoSpan iS = infoSpan -- | Parse of a string, which should contain a complete Haskell module. parseModule :: String -> ParseResult (Module SrcSpanInfo) parseModule = simpleParse mparseModule -- | Parse of a string containing a complete Haskell module, using an explicit mode. parseModuleWithMode :: ParseMode -> String -> ParseResult (Module SrcSpanInfo) parseModuleWithMode = modeParse mparseModule -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseModuleWithComments :: ParseMode -> String -> ParseResult (Module SrcSpanInfo, [Comment]) parseModuleWithComments = commentParse mparseModule -- | Parse of a string containing a Haskell expression. parseExp :: String -> ParseResult (Exp SrcSpanInfo) parseExp = simpleParse mparseExp -- | Parse of a string containing a Haskell expression, using an explicit mode. parseExpWithMode :: ParseMode -> String -> ParseResult (Exp SrcSpanInfo) parseExpWithMode = modeParse mparseExp -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseExpWithComments :: ParseMode -> String -> ParseResult (Exp SrcSpanInfo, [Comment]) parseExpWithComments = commentParse mparseExp -- | Parse of a string containing a Haskell pattern. parsePat :: String -> ParseResult (Pat SrcSpanInfo) parsePat = simpleParse mparsePat -- | Parse of a string containing a Haskell pattern, using an explicit mode. parsePatWithMode :: ParseMode -> String -> ParseResult (Pat SrcSpanInfo) parsePatWithMode = modeParse mparsePat -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parsePatWithComments :: ParseMode -> String -> ParseResult (Pat SrcSpanInfo, [Comment]) parsePatWithComments = commentParse mparsePat -- | Parse of a string containing a Haskell top-level declaration. parseDecl :: String -> ParseResult (Decl SrcSpanInfo) parseDecl = simpleParse mparseDecl -- | Parse of a string containing a Haskell top-level declaration, using an explicit mode. parseDeclWithMode :: ParseMode -> String -> ParseResult (Decl SrcSpanInfo) parseDeclWithMode = modeParse mparseDecl -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseDeclWithComments :: ParseMode -> String -> ParseResult (Decl SrcSpanInfo, [Comment]) parseDeclWithComments = commentParse mparseDecl -- | Parse of a string containing a Haskell type. parseType :: String -> ParseResult (Type SrcSpanInfo) parseType = runParser mparseType -- | Parse of a string containing a Haskell type, using an explicit mode. parseTypeWithMode :: ParseMode -> String -> ParseResult (Type SrcSpanInfo) parseTypeWithMode mode = runParserWithMode mode mparseType -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseTypeWithComments :: ParseMode -> String -> ParseResult (Type SrcSpanInfo, [Comment]) parseTypeWithComments mode str = runParserWithModeComments mode mparseType str -- | Parse of a string containing a Haskell statement. parseStmt :: String -> ParseResult (Stmt SrcSpanInfo) parseStmt = runParser mparseStmt -- | Parse of a string containing a Haskell type, using an explicit mode. parseStmtWithMode :: ParseMode -> String -> ParseResult (Stmt SrcSpanInfo) parseStmtWithMode mode = runParserWithMode mode mparseStmt -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseStmtWithComments :: ParseMode -> String -> ParseResult (Stmt SrcSpanInfo, [Comment]) parseStmtWithComments mode str = runParserWithModeComments mode mparseStmt str simpleParse :: AppFixity a => P (a L) -> String -> ParseResult (a L) simpleParse p = applyFixities preludeFixities <=< runParser p modeParse :: AppFixity a => P (a L) -> ParseMode -> String -> ParseResult (a L) modeParse p mode = applyFixities' (fixities mode) <=< runParserWithMode mode p commentParse :: AppFixity a => P (a L) -> ParseMode -> String -> ParseResult (a L, [Comment]) commentParse p mode str = do (ast, cs) <- runParserWithModeComments mode p str ast' <- applyFixities' (fixities mode) ast return (ast', cs) -- | Partial parse of a string starting with a series of top-level option pragmas. getTopPragmas :: String -> ParseResult [ModulePragma SrcSpanInfo] getTopPragmas = runParser (mfindOptPragmas >>= \(ps,_,_) -> return ps) -- | Parse of a string, which should contain a complete Haskell module. parseModules :: String -> ParseResult [Module SrcSpanInfo] parseModules = mapM (applyFixities preludeFixities) <=< runParser mparseModules -- | Parse of a string containing a complete Haskell module, using an explicit mode. parseModulesWithMode :: ParseMode -> String -> ParseResult [Module SrcSpanInfo] parseModulesWithMode mode = mapM (applyFixities' (fixities mode)) <=< runParserWithMode mode mparseModules -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseModulesWithComments :: ParseMode -> String -> ParseResult ([Module SrcSpanInfo], [Comment]) parseModulesWithComments mode str = do (ast,cs) <- runParserWithModeComments mode mparseModules str ast' <- mapM (applyFixities' (fixities mode)) ast return (ast', cs) applyFixities' :: (AppFixity a) => Maybe [Fixity] -> a L -> ParseResult (a L) applyFixities' Nothing ast = return ast applyFixities' (Just fixs) ast = applyFixities fixs ast {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp {-# LINE 30 "templates/GenericTemplate.hs" #-} data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList {-# LINE 51 "templates/GenericTemplate.hs" #-} {-# LINE 61 "templates/GenericTemplate.hs" #-} {-# LINE 70 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) ----------------------------------------------------------------------------- -- starting the parse happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll ----------------------------------------------------------------------------- -- Accepting the parse -- If the current token is 0#, it means we've just accepted a partial -- parse (a %partial parser). We must ignore the saved token on the top of -- the stack in this case. happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action happyDoAction i tk st = {- nothing -} case action of 0# -> {- nothing -} happyFail i tk st -1# -> {- nothing -} happyAccept i tk st n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} (happyReduceArr Happy_Data_Array.! rule) i tk st where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) n -> {- nothing -} happyShift new_state i tk st where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) where (off) = indexShortOffAddr happyActOffsets st (off_i) = (off Happy_GHC_Exts.+# i) check = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#)) then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) else False (action) | check = indexShortOffAddr happyTable off_i | otherwise = indexShortOffAddr happyDefActions st {-# LINE 130 "templates/GenericTemplate.hs" #-} indexShortOffAddr (HappyA# arr) off = Happy_GHC_Exts.narrow16Int# i where i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) off' = off Happy_GHC_Exts.*# 2# data HappyAddr = HappyA# Happy_GHC_Exts.Addr# ----------------------------------------------------------------------------- -- HappyState data type (not arrays) {-# LINE 163 "templates/GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- Shifting a token happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in -- trace "shifting the error token" $ happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) happyShift new_state i tk st sts stk = happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) -- happyReduce is specialised for the common cases. happySpecReduce_0 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_0 nt fn j tk st@((action)) sts stk = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) happySpecReduce_1 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') = let r = fn v1 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happySpecReduce_2 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') = let r = fn v1 v2 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happySpecReduce_3 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') = let r = fn v1 v2 v3 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happyReduce k i fn 0# tk st sts stk = happyFail 0# tk st sts stk happyReduce k nt fn j tk st sts stk = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of sts1@((HappyCons (st1@(action)) (_))) -> let r = fn stk in -- it doesn't hurt to always seq here... happyDoSeq r (happyGoto nt j tk st1 sts1 r) happyMonadReduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonadReduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk happyMonad2Reduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk (off) = indexShortOffAddr happyGotoOffsets st1 (off_i) = (off Happy_GHC_Exts.+# nt) (new_state) = indexShortOffAddr happyTable off_i happyDrop 0# l = l happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t happyDropStk 0# l = l happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs ----------------------------------------------------------------------------- -- Moving to a new state after a reduction happyGoto nt j tk st = {- nothing -} happyDoAction j tk new_state where (off) = indexShortOffAddr happyGotoOffsets st (off_i) = (off Happy_GHC_Exts.+# nt) (new_state) = indexShortOffAddr happyTable off_i ----------------------------------------------------------------------------- -- Error recovery (0# is the error token) -- parse error if we are in recovery and we fail again happyFail 0# tk old_st _ stk@(x `HappyStk` _) = let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in -- trace "failing" $ happyError_ i tk {- We don't need state discarding for our restricted implementation of "error". In fact, it can cause some bogus parses, so I've disabled it for now --SDM -- discard a state happyFail 0# tk old_st (HappyCons ((action)) (sts)) (saved_tok `HappyStk` _ `HappyStk` stk) = -- trace ("discarding state, depth " ++ show (length stk)) $ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) -} -- Enter error recovery: generate an error token, -- save the old token and carry on. happyFail i tk (action) sts stk = -- trace "entering error recovery" $ happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) -- Internal happy errors: notHappyAtAll :: a notHappyAtAll = error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions happyTcHack :: Happy_GHC_Exts.Int# -> a -> a happyTcHack x y = y {-# INLINE happyTcHack #-} ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits -- happySeq = happyDoSeq -- otherwise it emits -- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b happyDontSeq a b = b ----------------------------------------------------------------------------- -- Don't inline any functions from the template. GHC has a nasty habit -- of deciding to inline happyGoto everywhere, which increases the size of -- the generated parser quite a bit. {-# NOINLINE happyDoAction #-} {-# NOINLINE happyTable #-} {-# NOINLINE happyCheck #-} {-# NOINLINE happyActOffsets #-} {-# NOINLINE happyGotoOffsets #-} {-# NOINLINE happyDefActions #-} {-# NOINLINE happyShift #-} {-# NOINLINE happySpecReduce_0 #-} {-# NOINLINE happySpecReduce_1 #-} {-# NOINLINE happySpecReduce_2 #-} {-# NOINLINE happySpecReduce_3 #-} {-# NOINLINE happyReduce #-} {-# NOINLINE happyMonadReduce #-} {-# NOINLINE happyGoto #-} {-# NOINLINE happyFail #-} -- end of Happy Template. haskell-src-exts-1.14.0/src/0000755000000000000000000000000012204617765013755 5ustar0000000000000000haskell-src-exts-1.14.0/src/Language/0000755000000000000000000000000012204617765015500 5ustar0000000000000000haskell-src-exts-1.14.0/src/Language/Haskell/0000755000000000000000000000000012204617765017063 5ustar0000000000000000haskell-src-exts-1.14.0/src/Language/Haskell/Exts.hs0000644000000000000000000001403112204617765020341 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts -- Copyright : (c) Niklas Broberg 2004-2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- An umbrella module for the various functionality -- of the package. Also provides some convenient -- functionality for dealing directly with source files. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts ( -- * Re-exported modules module Language.Haskell.Exts.Syntax , module Language.Haskell.Exts.Build , module Language.Haskell.Exts.Lexer , module Language.Haskell.Exts.Parser , module Language.Haskell.Exts.Pretty , module Language.Haskell.Exts.Extension , module Language.Haskell.Exts.Fixity , module Language.Haskell.Exts.Comments -- * Parsing of Haskell source files , parseFile , parseFileWithMode , parseFileWithExts , parseFileWithComments , parseFileContents , parseFileContentsWithMode , parseFileContentsWithExts , parseFileContentsWithComments -- * Read extensions declared in LANGUAGE pragmas , readExtensions ) where import Language.Haskell.Exts.Build import Language.Haskell.Exts.Syntax import Language.Haskell.Exts.Parser import Language.Haskell.Exts.Lexer import Language.Haskell.Exts.Pretty import Language.Haskell.Exts.Extension import Language.Haskell.Exts.Fixity import Language.Haskell.Exts.Comments import Data.List import Language.Preprocessor.Unlit -- | Parse a source file on disk, using the default parse mode. parseFile :: FilePath -> IO (ParseResult Module) parseFile fp = parseFileWithMode (defaultParseMode { parseFilename = fp }) fp -- | Parse a source file on disk, with an extra set of extensions to know about -- on top of what the file itself declares. parseFileWithExts :: [Extension] -> FilePath -> IO (ParseResult Module) parseFileWithExts exts fp = parseFileWithMode (defaultParseMode { extensions = exts, parseFilename = fp }) fp -- | Parse a source file on disk, supplying a custom parse mode. parseFileWithMode :: ParseMode -> FilePath -> IO (ParseResult Module) parseFileWithMode p fp = readFile fp >>= (return . parseFileContentsWithMode p) -- | Parse a source file on disk, supplying a custom parse mode, and retaining comments. parseFileWithComments :: ParseMode -> FilePath -> IO (ParseResult (Module, [Comment])) parseFileWithComments p fp = readFile fp >>= (return . parseFileContentsWithComments p) -- | Parse a source file from a string using the default parse mode. parseFileContents :: String -> ParseResult Module parseFileContents = parseFileContentsWithMode defaultParseMode -- | Parse a source file from a string, with an extra set of extensions to know about -- on top of what the file itself declares. parseFileContentsWithExts :: [Extension] -> String -> ParseResult Module parseFileContentsWithExts exts = parseFileContentsWithMode (defaultParseMode { extensions = exts }) -- | Parse a source file from a string using a custom parse mode. parseFileContentsWithMode :: ParseMode -> String -> ParseResult Module parseFileContentsWithMode p@(ParseMode fn oldLang exts ign _ _) rawStr = let md = delit fn $ ppContents rawStr (bLang, extraExts) = case (ign, readExtensions md) of (False, Just (mLang, es)) -> (case mLang of {Nothing -> oldLang;Just newLang -> newLang}, es) _ -> (oldLang, []) in parseWithMode (p { baseLanguage = bLang, extensions = exts ++ extraExts }) md -- | Parse a source file from a string using a custom parse mode and retaining comments. parseFileContentsWithComments :: ParseMode -> String -> ParseResult (Module, [Comment]) parseFileContentsWithComments p@(ParseMode fn oldLang exts ign _ _) rawStr = let md = delit fn $ ppContents rawStr (bLang, extraExts) = case (ign, readExtensions md) of (False, Just (mLang, es)) -> (case mLang of {Nothing -> oldLang;Just newLang -> newLang}, es) _ -> (oldLang, []) in parseWithComments (p { baseLanguage = bLang, extensions = exts ++ extraExts }) md {-- | Gather the extensions declared in LANGUAGE pragmas -- at the top of the file. Returns 'Nothing' if the -- parse of the pragmas fails. readExtensions :: String -> Maybe [Extension] readExtensions str = case getTopPragmas str of ParseOk pgms -> Just (concatMap getExts pgms) _ -> Nothing where getExts :: ModulePragma -> [Extension] getExts (LanguagePragma _ ns) = map readExt ns getExts _ = [] readExt (Ident e) = classifyExtension e -} -- | Gather the extensions declared in LANGUAGE pragmas -- at the top of the file. Returns 'Nothing' if the -- parse of the pragmas fails. readExtensions :: String -> Maybe (Maybe Language, [Extension]) readExtensions str = case getTopPragmas str of ParseOk pgms -> extractLang $ concatMap getExts pgms _ -> Nothing where getExts :: ModulePragma -> [Either Language Extension] getExts (LanguagePragma _ ns) = map readExt ns getExts _ = [] readExt (Ident e) = case classifyLanguage e of UnknownLanguage _ -> Right $ classifyExtension e lang -> Left lang extractLang = extractLang' Nothing [] extractLang' lacc eacc [] = Just (lacc, eacc) extractLang' Nothing eacc (Left l : rest) = extractLang' (Just l) eacc rest extractLang' (Just l1) eacc (Left l2:rest) | l1 == l2 = extractLang' (Just l1) eacc rest | otherwise = Nothing extractLang' lacc eacc (Right ext : rest) = extractLang' lacc (ext:eacc) rest ppContents :: String -> String ppContents = unlines . f . lines where f (('#':_):rest) = rest f x = x delit :: String -> String -> String delit fn = if ".lhs" `isSuffixOf` fn then unlit fn else idhaskell-src-exts-1.14.0/src/Language/Haskell/Exts/0000755000000000000000000000000012204617765020006 5ustar0000000000000000haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Parser.hs0000644000000000000000000002030612204617765021577 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Parser -- Copyright : (c) The GHC Team, 1997-2000 -- (c) Niklas Broberg, 2004-2012 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, niklas.broberg@chalmers.se -- Stability : stable -- Portability : portable -- -- Parser for Haskell with extensions. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Parser ( -- * General parsing Parseable(..), ParseMode(..), defaultParseMode, ParseResult(..), fromParseResult, -- * Parsing of specific AST elements -- ** Modules parseModule, parseModuleWithMode, parseModuleWithComments, -- ** Expressions parseExp, parseExpWithMode, parseExpWithComments, -- ** Statements parseStmt, parseStmtWithMode, parseStmtWithComments, -- ** Patterns parsePat, parsePatWithMode, parsePatWithComments, -- ** Declarations parseDecl, parseDeclWithMode, parseDeclWithComments, -- ** Types parseType, parseTypeWithMode, parseTypeWithComments, -- ** Option pragmas getTopPragmas ) where import Language.Haskell.Exts.InternalParser ( ParseMode(..), defaultParseMode, ParseResult(..), fromParseResult ) import qualified Language.Haskell.Exts.InternalParser as P import Language.Haskell.Exts.Annotated.Syntax import qualified Language.Haskell.Exts.Syntax as S import Language.Haskell.Exts.Annotated.Simplify import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.Comments getTopPragmas :: String -> ParseResult [S.ModulePragma] getTopPragmas = fmap (map sModulePragma) . P.getTopPragmas -- | Class to reuse the parse function at many different types. class Parseable ast where -- | Parse a string with default mode. parse :: String -> ParseResult ast -- | Parse a string with an explicit mode. parseWithMode :: ParseMode -> String -> ParseResult ast -- | Parse a string with an explicit mode, returning all comments along the AST parseWithComments :: ParseMode -> String -> ParseResult (ast, [Comment]) instance SrcInfo loc => Parseable (Module loc) where parse = fmap (fmap fromSrcInfo) . P.parseModule parseWithMode = (fmap (fmap fromSrcInfo) .) . P.parseModuleWithMode parseWithComments md s = P.parseModuleWithComments md s >>= \(r, cs) -> return (fmap fromSrcInfo r, cs) instance SrcInfo loc => Parseable (Exp loc) where parse = fmap (fmap fromSrcInfo) . P.parseExp parseWithMode = (fmap (fmap fromSrcInfo) .) . P.parseExpWithMode parseWithComments md s = P.parseExpWithComments md s >>= \(r, cs) -> return (fmap fromSrcInfo r, cs) instance SrcInfo loc => Parseable (Pat loc) where parse = fmap (fmap fromSrcInfo) . P.parsePat parseWithMode = (fmap (fmap fromSrcInfo) .) . P.parsePatWithMode parseWithComments md s = P.parsePatWithComments md s >>= \(r, cs) -> return (fmap fromSrcInfo r, cs) instance SrcInfo loc => Parseable (Decl loc) where parse = fmap (fmap fromSrcInfo) . P.parseDecl parseWithMode = (fmap (fmap fromSrcInfo) .) . P.parseDeclWithMode parseWithComments md s = P.parseDeclWithComments md s >>= \(r, cs) -> return (fmap fromSrcInfo r, cs) instance SrcInfo loc => Parseable (Type loc) where parse = fmap (fmap fromSrcInfo) . P.parseType parseWithMode = (fmap (fmap fromSrcInfo) .) . P.parseTypeWithMode parseWithComments md s = P.parseTypeWithComments md s >>= \(r, cs) -> return (fmap fromSrcInfo r, cs) instance SrcInfo loc => Parseable (Stmt loc) where parse = fmap (fmap fromSrcInfo) . P.parseStmt parseWithMode = (fmap (fmap fromSrcInfo) .) . P.parseStmtWithMode parseWithComments md s = P.parseStmtWithComments md s >>= \(r, cs) -> return (fmap fromSrcInfo r, cs) -- | Parse of a string, which should contain a complete Haskell module. parseModule :: String -> ParseResult S.Module parseModule = fmap sModule . P.parseModule -- | Parse of a string containing a complete Haskell module, using an explicit mode. parseModuleWithMode :: ParseMode -> String -> ParseResult S.Module parseModuleWithMode = (fmap sModule .) . P.parseModuleWithMode -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseModuleWithComments :: ParseMode -> String -> ParseResult (S.Module, [Comment]) parseModuleWithComments = (fmap (\(mod, cs) -> (sModule mod, cs)) .) . P.parseModuleWithComments -- | Parse of a string containing a Haskell expression. parseExp :: String -> ParseResult S.Exp parseExp = fmap sExp . P.parseExp -- | Parse of a string containing a Haskell expression, using an explicit mode. parseExpWithMode :: ParseMode -> String -> ParseResult S.Exp parseExpWithMode = (fmap sExp .) . P.parseExpWithMode -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseExpWithComments :: ParseMode -> String -> ParseResult (S.Exp, [Comment]) parseExpWithComments = (fmap (\(e, cs) -> (sExp e, cs)) .) . P.parseExpWithComments -- | Parse of a string containing a Haskell pattern. parsePat :: String -> ParseResult S.Pat parsePat = fmap sPat . P.parsePat -- | Parse of a string containing a Haskell pattern, using an explicit mode. parsePatWithMode :: ParseMode -> String -> ParseResult S.Pat parsePatWithMode = (fmap sPat .) . P.parsePatWithMode -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parsePatWithComments :: ParseMode -> String -> ParseResult (S.Pat, [Comment]) parsePatWithComments = (fmap (\(p, cs) -> (sPat p, cs)) .) . P.parsePatWithComments -- | Parse of a string containing a Haskell top-level declaration. parseDecl :: String -> ParseResult S.Decl parseDecl = fmap sDecl . P.parseDecl -- | Parse of a string containing a Haskell top-level declaration, using an explicit mode. parseDeclWithMode :: ParseMode -> String -> ParseResult S.Decl parseDeclWithMode = (fmap sDecl .) . P.parseDeclWithMode -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseDeclWithComments :: ParseMode -> String -> ParseResult (S.Decl, [Comment]) parseDeclWithComments = (fmap (\(decl, cs) -> (sDecl decl, cs)) .) . P.parseDeclWithComments -- | Parse of a string containing a Haskell type. parseType :: String -> ParseResult S.Type parseType = fmap sType . P.parseType -- | Parse of a string containing a Haskell type, using an explicit mode. parseTypeWithMode :: ParseMode -> String -> ParseResult S.Type parseTypeWithMode = (fmap sType .) . P.parseTypeWithMode -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseTypeWithComments :: ParseMode -> String -> ParseResult (S.Type, [Comment]) parseTypeWithComments = (fmap (\(t, cs) -> (sType t, cs)) .) . P.parseTypeWithComments -- | Parse of a string containing a Haskell type. parseStmt :: String -> ParseResult S.Stmt parseStmt = fmap sStmt . P.parseStmt -- | Parse of a string containing a Haskell type, using an explicit mode. parseStmtWithMode :: ParseMode -> String -> ParseResult S.Stmt parseStmtWithMode = (fmap sStmt .) . P.parseStmtWithMode -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. parseStmtWithComments :: ParseMode -> String -> ParseResult (S.Stmt, [Comment]) parseStmtWithComments = (fmap (\(s, cs) -> (sStmt s, cs)) .) . P.parseStmtWithComments instance Parseable S.Module where parse = parseModule parseWithMode = parseModuleWithMode parseWithComments = parseModuleWithComments instance Parseable S.Exp where parse = parseExp parseWithMode = parseExpWithMode parseWithComments = parseExpWithComments instance Parseable S.Pat where parse = parsePat parseWithMode = parsePatWithMode parseWithComments = parsePatWithComments instance Parseable S.Decl where parse = parseDecl parseWithMode = parseDeclWithMode parseWithComments = parseDeclWithComments instance Parseable S.Type where parse = parseType parseWithMode = parseTypeWithMode parseWithComments = parseTypeWithComments haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Syntax.hs0000644000000000000000000010625612204617765021642 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Syntax -- Copyright : (c) Niklas Broberg 2004-2009, -- (c) The GHC Team, 1997-2000 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- A suite of datatypes describing the abstract syntax of Haskell 98 -- plus registered extensions, including: -- -- * multi-parameter type classes with functional dependencies (MultiParamTypeClasses, FunctionalDependencies) -- -- * parameters of type class assertions are unrestricted (FlexibleContexts) -- -- * 'forall' types as universal and existential quantification (RankNTypes, ExistentialQuantification, etc) -- -- * pattern guards (PatternGuards) -- -- * implicit parameters (ImplicitParameters) -- -- * generalised algebraic data types (GADTs) -- -- * template haskell (TemplateHaskell) -- -- * empty data type declarations (EmptyDataDecls) -- -- * unboxed tuples (UnboxedTuples) -- -- * regular patterns (RegularPatterns) -- -- * HSP-style XML expressions and patterns (XmlSyntax) -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Syntax ( -- * Modules Module(..), WarningText(..), ExportSpec(..), ImportDecl(..), ImportSpec(..), Assoc(..), -- * Declarations Decl(..), Binds(..), IPBind(..), -- ** Type classes and instances ClassDecl(..), InstDecl(..), Deriving, -- ** Data type declarations DataOrNew(..), ConDecl(..), QualConDecl(..), GadtDecl(..), BangType(..), -- ** Function bindings Match(..), Rhs(..), GuardedRhs(..), -- * Class Assertions and Contexts Context, FunDep(..), Asst(..), -- * Types Type(..), Boxed(..), Kind(..), TyVarBind(..), -- * Expressions Exp(..), Stmt(..), QualStmt(..), FieldUpdate(..), Alt(..), GuardedAlts(..), GuardedAlt(..), XAttr(..), -- * Patterns Pat(..), PatField(..), PXAttr(..), RPat(..), RPatOp(..), -- * Literals Literal(..), -- * Variables, Constructors and Operators ModuleName(..), QName(..), Name(..), QOp(..), Op(..), SpecialCon(..), CName(..), IPName(..), XName(..), -- * Template Haskell Bracket(..), Splice(..), -- * FFI Safety(..), CallConv(..), -- * Pragmas ModulePragma(..), Tool(..), Rule(..), RuleVar(..), Activation(..), Annotation(..), -- * Builtin names -- ** Modules prelude_mod, main_mod, -- ** Main function of a program main_name, -- ** Constructors unit_con_name, tuple_con_name, list_cons_name, unboxed_singleton_con_name, unit_con, tuple_con, unboxed_singleton_con, -- ** Special identifiers as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name, export_name, safe_name, unsafe_name, threadsafe_name, stdcall_name, ccall_name, cplusplus_name, dotnet_name, jvm_name, js_name, forall_name, family_name, -- ** Type constructors unit_tycon_name, fun_tycon_name, list_tycon_name, tuple_tycon_name, unboxed_singleton_tycon_name, unit_tycon, fun_tycon, list_tycon, tuple_tycon, unboxed_singleton_tycon, -- * Source coordinates SrcLoc(..), ) where #ifdef __GLASGOW_HASKELL__ #ifdef BASE4 import Data.Data #else import Data.Generics (Data(..),Typeable(..)) #endif #endif import Language.Haskell.Exts.SrcLoc (SrcLoc(..)) import Language.Haskell.Exts.Annotated.Syntax (Boxed(..), Tool(..)) -- | The name of a Haskell module. newtype ModuleName = ModuleName String #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Constructors with special syntax. -- These names are never qualified, and always refer to builtin type or -- data constructors. data SpecialCon = UnitCon -- ^ unit type and data constructor @()@ | ListCon -- ^ list type constructor @[]@ | FunCon -- ^ function type constructor @->@ | TupleCon Boxed Int -- ^ /n/-ary tuple type and data -- constructors @(,)@ etc, possibly boxed @(\#,\#)@ | Cons -- ^ list data constructor @(:)@ | UnboxedSingleCon -- ^ unboxed singleton tuple constructor @(\# \#)@ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | This type is used to represent qualified variables, and also -- qualified constructors. data QName = Qual ModuleName Name -- ^ name qualified with a module name | UnQual Name -- ^ unqualified local name | Special SpecialCon -- ^ built-in constructor with special syntax #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | This type is used to represent variables, and also constructors. data Name = Ident String -- ^ /varid/ or /conid/. | Symbol String -- ^ /varsym/ or /consym/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An implicit parameter name. data IPName = IPDup String -- ^ ?/ident/, non-linear implicit parameter | IPLin String -- ^ %/ident/, linear implicit parameter #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Possibly qualified infix operators (/qop/), appearing in expressions. data QOp = QVarOp QName -- ^ variable operator (/qvarop/) | QConOp QName -- ^ constructor operator (/qconop/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Operators appearing in @infix@ declarations are never qualified. data Op = VarOp Name -- ^ variable operator (/varop/) | ConOp Name -- ^ constructor operator (/conop/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A name (/cname/) of a component of a class or data type in an @import@ -- or export specification. data CName = VarName Name -- ^ name of a method or field | ConName Name -- ^ name of a data constructor #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A complete Haskell source module. data Module = Module SrcLoc ModuleName [ModulePragma] (Maybe WarningText) (Maybe [ExportSpec]) [ImportDecl] [Decl] #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An item in a module's export specification. data ExportSpec = EVar QName -- ^ variable | EAbs QName -- ^ @T@: -- a class or datatype exported abstractly, -- or a type synonym. | EThingAll QName -- ^ @T(..)@: -- a class exported with all of its methods, or -- a datatype exported with all of its constructors. | EThingWith QName [CName] -- ^ @T(C_1,...,C_n)@: -- a class exported with some of its methods, or -- a datatype exported with some of its constructors. | EModuleContents ModuleName -- ^ @module M@: -- re-export a module. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An import declaration. data ImportDecl = ImportDecl { importLoc :: SrcLoc -- ^ position of the @import@ keyword. , importModule :: ModuleName -- ^ name of the module imported. , importQualified :: Bool -- ^ imported @qualified@? , importSrc :: Bool -- ^ imported with @{-\# SOURCE \#-}@? , importPkg :: Maybe String -- ^ imported with explicit package name , importAs :: Maybe ModuleName -- ^ optional alias name in an @as@ clause. , importSpecs :: Maybe (Bool,[ImportSpec]) -- ^ optional list of import specifications. -- The 'Bool' is 'True' if the names are excluded -- by @hiding@. } #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An import specification, representing a single explicit item imported -- (or hidden) from a module. data ImportSpec = IVar Name -- ^ variable | IAbs Name -- ^ @T@: -- the name of a class, datatype or type synonym. | IThingAll Name -- ^ @T(..)@: -- a class imported with all of its methods, or -- a datatype imported with all of its constructors. | IThingWith Name [CName] -- ^ @T(C_1,...,C_n)@: -- a class imported with some of its methods, or -- a datatype imported with some of its constructors. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Associativity of an operator. data Assoc = AssocNone -- ^ non-associative operator (declared with @infix@) | AssocLeft -- ^ left-associative operator (declared with @infixl@). | AssocRight -- ^ right-associative operator (declared with @infixr@) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A single derived instance, which may have arguments since it may be a MPTC. type Deriving = (QName, [Type]) -- | A top-level declaration. data Decl = TypeDecl SrcLoc Name [TyVarBind] Type -- ^ A type declaration | TypeFamDecl SrcLoc Name [TyVarBind] (Maybe Kind) -- ^ A type family declaration | DataDecl SrcLoc DataOrNew Context Name [TyVarBind] [QualConDecl] [Deriving] -- ^ A data OR newtype declaration | GDataDecl SrcLoc DataOrNew Context Name [TyVarBind] (Maybe Kind) [GadtDecl] [Deriving] -- ^ A data OR newtype declaration, GADT style | DataFamDecl SrcLoc {-data-} Context Name [TyVarBind] (Maybe Kind) -- ^ A data family declaration | TypeInsDecl SrcLoc Type Type -- ^ A type family instance declaration | DataInsDecl SrcLoc DataOrNew Type [QualConDecl] [Deriving] -- ^ A data family instance declaration | GDataInsDecl SrcLoc DataOrNew Type (Maybe Kind) [GadtDecl] [Deriving] -- ^ A data family instance declaration, GADT style | ClassDecl SrcLoc Context Name [TyVarBind] [FunDep] [ClassDecl] -- ^ A declaration of a type class | InstDecl SrcLoc Context QName [Type] [InstDecl] -- ^ An declaration of a type class instance | DerivDecl SrcLoc Context QName [Type] -- ^ A standalone deriving declaration | InfixDecl SrcLoc Assoc Int [Op] -- ^ A declaration of operator fixity | DefaultDecl SrcLoc [Type] -- ^ A declaration of default types | SpliceDecl SrcLoc Exp -- ^ A Template Haskell splicing declaration | TypeSig SrcLoc [Name] Type -- ^ A type signature declaration | FunBind [Match] -- ^ A set of function binding clauses | PatBind SrcLoc Pat (Maybe Type) Rhs {-where-} Binds -- ^ A pattern binding | ForImp SrcLoc CallConv Safety String Name Type -- ^ A foreign import declaration | ForExp SrcLoc CallConv String Name Type -- ^ A foreign export declaration | RulePragmaDecl SrcLoc [Rule] -- ^ A RULES pragma | DeprPragmaDecl SrcLoc [([Name], String)] -- ^ A DEPRECATED pragma | WarnPragmaDecl SrcLoc [([Name], String)] -- ^ A WARNING pragma | InlineSig SrcLoc Bool Activation QName -- ^ An INLINE pragma | InlineConlikeSig SrcLoc Activation QName -- ^ An INLINE CONLIKE pragma | SpecSig SrcLoc Activation QName [Type] -- ^ A SPECIALISE pragma | SpecInlineSig SrcLoc Bool Activation QName [Type] -- ^ A SPECIALISE INLINE pragma | InstSig SrcLoc Context QName [Type] -- ^ A SPECIALISE instance pragma | AnnPragma SrcLoc Annotation -- ^ An ANN pragma #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An annotation through an ANN pragma. data Annotation = Ann Name Exp -- ^ An annotation for a declared name. | TypeAnn Name Exp -- ^ An annotation for a declared type. | ModuleAnn Exp -- ^ An annotation for the defining module. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A flag stating whether a declaration is a data or newtype declaration. data DataOrNew = DataType | NewType #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A binding group inside a @let@ or @where@ clause. data Binds = BDecls [Decl] -- ^ An ordinary binding group | IPBinds [IPBind] -- ^ A binding group for implicit parameters #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A binding of an implicit parameter. data IPBind = IPBind SrcLoc IPName Exp #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Clauses of a function binding. data Match = Match SrcLoc Name [Pat] (Maybe Type) Rhs {-where-} Binds #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A single constructor declaration within a data type declaration, -- which may have an existential quantification binding. data QualConDecl = QualConDecl SrcLoc {-forall-} [TyVarBind] {- . -} Context {- => -} ConDecl #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Declaration of an ordinary data constructor. data ConDecl = ConDecl Name [BangType] -- ^ ordinary data constructor | InfixConDecl BangType Name BangType -- ^ infix data constructor | RecDecl Name [([Name],BangType)] -- ^ record constructor #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A single constructor declaration in a GADT data type declaration. data GadtDecl = GadtDecl SrcLoc Name Type #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Declarations inside a class declaration. data ClassDecl = ClsDecl Decl -- ^ ordinary declaration | ClsDataFam SrcLoc Context Name [TyVarBind] (Maybe Kind) -- ^ declaration of an associated data type | ClsTyFam SrcLoc Name [TyVarBind] (Maybe Kind) -- ^ declaration of an associated type synonym | ClsTyDef SrcLoc Type Type -- ^ default choice for an associated type synonym #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Declarations inside an instance declaration. data InstDecl = InsDecl Decl -- ^ ordinary declaration | InsType SrcLoc Type Type -- ^ an associated type definition | InsData SrcLoc DataOrNew Type [QualConDecl] [Deriving] -- ^ an associated data type implementation | InsGData SrcLoc DataOrNew Type (Maybe Kind) [GadtDecl] [Deriving] -- ^ an associated data type implemented using GADT style #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | The type of a constructor argument or field, optionally including -- a strictness annotation. data BangType = BangedTy Type -- ^ strict component, marked with \"@!@\" | UnBangedTy Type -- ^ non-strict component | UnpackedTy Type -- ^ unboxed component, marked with an UNPACK pragma #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | The right hand side of a function or pattern binding. data Rhs = UnGuardedRhs Exp -- ^ unguarded right hand side (/exp/) | GuardedRhss [GuardedRhs] -- ^ guarded right hand side (/gdrhs/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A guarded right hand side @|@ /stmts/ @=@ /exp/. -- The guard is a series of statements when using pattern guards, -- otherwise it will be a single qualifier expression. data GuardedRhs = GuardedRhs SrcLoc [Stmt] Exp #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A type qualified with a context. -- An unqualified type has an empty context. data Type = TyForall (Maybe [TyVarBind]) Context Type -- ^ qualified type | TyFun Type Type -- ^ function type | TyTuple Boxed [Type] -- ^ tuple type, possibly boxed | TyList Type -- ^ list syntax, e.g. [a], as opposed to [] a | TyApp Type Type -- ^ application of a type constructor | TyVar Name -- ^ type variable | TyCon QName -- ^ named type or type constructor | TyParen Type -- ^ type surrounded by parentheses | TyInfix Type QName Type -- ^ infix type constructor | TyKind Type Kind -- ^ type with explicit kind signature #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A type variable declaration, optionally with an explicit kind annotation. data TyVarBind = KindedVar Name Kind -- ^ variable binding with kind annotation | UnkindedVar Name -- ^ ordinary variable binding #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An explicit kind annotation. data Kind = KindStar -- ^ @*@, the kind of types | KindBang -- ^ @!@, the kind of unboxed types | KindFn Kind Kind -- ^ @->@, the kind of a type constructor | KindParen Kind -- ^ a kind surrounded by parentheses | KindVar Name -- ^ a kind variable (as of yet unsupported by compilers) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A functional dependency, given on the form -- l1 l2 ... ln -> r2 r3 .. rn data FunDep = FunDep [Name] [Name] #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A context is a set of assertions type Context = [Asst] -- | Class assertions. -- In Haskell 98, the argument would be a /tyvar/, but this definition -- allows multiple parameters, and allows them to be /type/s. -- Also extended with support for implicit parameters and equality constraints. data Asst = ClassA QName [Type] -- ^ ordinary class assertion | InfixA Type QName Type -- ^ class assertion where the class name is given infix | IParam IPName Type -- ^ implicit parameter assertion | EqualP Type Type -- ^ type equality constraint #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | /literal/ -- Values of this type hold the abstract value of the literal, not the -- precise string representation used. For example, @10@, @0o12@ and @0xa@ -- have the same representation. data Literal = Char Char -- ^ character literal | String String -- ^ string literal | Int Integer -- ^ integer literal | Frac Rational -- ^ floating point literal | PrimInt Integer -- ^ unboxed integer literal | PrimWord Integer -- ^ unboxed word literal | PrimFloat Rational -- ^ unboxed float literal | PrimDouble Rational -- ^ unboxed double literal | PrimChar Char -- ^ unboxed character literal | PrimString String -- ^ unboxed string literal #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Haskell expressions. data Exp = Var QName -- ^ variable | IPVar IPName -- ^ implicit parameter variable | Con QName -- ^ data constructor | Lit Literal -- ^ literal constant | InfixApp Exp QOp Exp -- ^ infix application | App Exp Exp -- ^ ordinary application | NegApp Exp -- ^ negation expression @-/exp/@ (unary minus) | Lambda SrcLoc [Pat] Exp -- ^ lambda expression | Let Binds Exp -- ^ local declarations with @let@ ... @in@ ... | If Exp Exp Exp -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/ | Case Exp [Alt] -- ^ @case@ /exp/ @of@ /alts/ | Do [Stmt] -- ^ @do@-expression: -- the last statement in the list -- should be an expression. | MDo [Stmt] -- ^ @mdo@-expression | Tuple Boxed [Exp] -- ^ tuple expression | TupleSection Boxed [Maybe Exp] -- ^ tuple section expression, e.g. @(,,3)@ | List [Exp] -- ^ list expression | Paren Exp -- ^ parenthesised expression | LeftSection Exp QOp -- ^ left section @(@/exp/ /qop/@)@ | RightSection QOp Exp -- ^ right section @(@/qop/ /exp/@)@ | RecConstr QName [FieldUpdate] -- ^ record construction expression | RecUpdate Exp [FieldUpdate] -- ^ record update expression | EnumFrom Exp -- ^ unbounded arithmetic sequence, -- incrementing by 1: @[from ..]@ | EnumFromTo Exp Exp -- ^ bounded arithmetic sequence, -- incrementing by 1 @[from .. to]@ | EnumFromThen Exp Exp -- ^ unbounded arithmetic sequence, -- with first two elements given @[from, then ..]@ | EnumFromThenTo Exp Exp Exp -- ^ bounded arithmetic sequence, -- with first two elements given @[from, then .. to]@ | ListComp Exp [QualStmt] -- ^ ordinary list comprehension | ParComp Exp [[QualStmt]] -- ^ parallel list comprehension | ExpTypeSig SrcLoc Exp Type -- ^ expression with explicit type signature | VarQuote QName -- ^ @'x@ for template haskell reifying of expressions | TypQuote QName -- ^ @''T@ for template haskell reifying of types | BracketExp Bracket -- ^ template haskell bracket expression | SpliceExp Splice -- ^ template haskell splice expression | QuasiQuote String String -- ^ quasi-quotaion: @[$/name/| /string/ |]@ -- Hsx | XTag SrcLoc XName [XAttr] (Maybe Exp) [Exp] -- ^ xml element, with attributes and children | XETag SrcLoc XName [XAttr] (Maybe Exp) -- ^ empty xml element, with attributes | XPcdata String -- ^ PCDATA child element | XExpTag Exp -- ^ escaped haskell expression inside xml | XChildTag SrcLoc [Exp] -- ^ children of an xml element -- Pragmas | CorePragma String Exp -- ^ CORE pragma | SCCPragma String Exp -- ^ SCC pragma | GenPragma String (Int, Int) (Int, Int) Exp -- ^ GENERATED pragma -- Arrows | Proc SrcLoc Pat Exp -- ^ arrows proc: @proc@ /pat/ @->@ /exp/ | LeftArrApp Exp Exp -- ^ arrow application (from left): /exp/ @-<@ /exp/ | RightArrApp Exp Exp -- ^ arrow application (from right): /exp/ @>-@ /exp/ | LeftArrHighApp Exp Exp -- ^ higher-order arrow application (from left): /exp/ @-<<@ /exp/ | RightArrHighApp Exp Exp -- ^ higher-order arrow application (from right): /exp/ @>>-@ /exp/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | The name of an xml element or attribute, -- possibly qualified with a namespace. data XName = XName String -- /pat/)@ | PRPat [RPat] -- ^ regular list pattern | PXTag SrcLoc XName [PXAttr] (Maybe Pat) [Pat] -- ^ XML element pattern | PXETag SrcLoc XName [PXAttr] (Maybe Pat) -- ^ XML singleton element pattern | PXPcdata String -- ^ XML PCDATA pattern | PXPatTag Pat -- ^ XML embedded pattern | PXRPats [RPat] -- ^ XML regular list pattern | PExplTypeArg QName Type -- ^ Explicit generics style type argument e.g. @f {| Int |} x = ...@ | PQuasiQuote String String -- ^ quasi quote patter: @[$/name/| /string/ |]@ | PBangPat Pat -- ^ strict (bang) pattern: @f !x = ...@ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An XML attribute in a pattern. data PXAttr = PXAttr XName Pat #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A regular pattern operator. data RPatOp = RPStar -- ^ @*@ = 0 or more | RPStarG -- ^ @*!@ = 0 or more, greedy | RPPlus -- ^ @+@ = 1 or more | RPPlusG -- ^ @+!@ = 1 or more, greedy | RPOpt -- ^ @?@ = 0 or 1 | RPOptG -- ^ @?!@ = 0 or 1, greedy #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An entity in a regular pattern. data RPat = RPOp RPat RPatOp -- ^ operator pattern, e.g. pat* | RPEither RPat RPat -- ^ choice pattern, e.g. (1 | 2) | RPSeq [RPat] -- ^ sequence pattern, e.g. (| 1, 2, 3 |) | RPGuard Pat [Stmt] -- ^ guarded pattern, e.g. (| p | p < 3 |) | RPCAs Name RPat -- ^ non-linear variable binding, e.g. (foo\@:(1 | 2))* | RPAs Name RPat -- ^ linear variable binding, e.g. foo\@(1 | 2) | RPParen RPat -- ^ parenthesised pattern, e.g. (2*) | RPPat Pat -- ^ an ordinary pattern #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An /fpat/ in a labeled record pattern. data PatField = PFieldPat QName Pat -- ^ ordinary label-pattern pair | PFieldPun Name -- ^ record field pun | PFieldWildcard -- ^ record field wildcard #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A statement, representing both a /stmt/ in a @do@-expression, -- an ordinary /qual/ in a list comprehension, as well as a /stmt/ -- in a pattern guard. data Stmt = Generator SrcLoc Pat Exp -- ^ a generator: /pat/ @<-@ /exp/ | Qualifier Exp -- ^ an /exp/ by itself: in a @do@-expression, -- an action whose result is discarded; -- in a list comprehension and pattern guard, -- a guard expression | LetStmt Binds -- ^ local bindings | RecStmt [Stmt] -- ^ a recursive binding group for arrows #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A general /transqual/ in a list comprehension, -- which could potentially be a transform of the kind -- enabled by TransformListComp. data QualStmt = QualStmt Stmt -- ^ an ordinary statement | ThenTrans Exp -- ^ @then@ /exp/ | ThenBy Exp Exp -- ^ @then@ /exp/ @by@ /exp/ | GroupBy Exp -- ^ @then@ @group@ @by@ /exp/ | GroupUsing Exp -- ^ @then@ @group@ @using@ /exp/ | GroupByUsing Exp Exp -- ^ @then@ @group@ @by@ /exp/ @using@ /exp/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An /fbind/ in a labeled construction or update expression. data FieldUpdate = FieldUpdate QName Exp -- ^ ordinary label-expresion pair | FieldPun Name -- ^ record field pun | FieldWildcard -- ^ record field wildcard #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | An /alt/ alternative in a @case@ expression. data Alt = Alt SrcLoc Pat GuardedAlts Binds #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | The right-hand sides of a @case@ alternative, -- which may be a single right-hand side or a -- set of guarded ones. data GuardedAlts = UnGuardedAlt Exp -- ^ @->@ /exp/ | GuardedAlts [GuardedAlt] -- ^ /gdpat/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A guarded case alternative @|@ /stmts/ @->@ /exp/. data GuardedAlt = GuardedAlt SrcLoc [Stmt] Exp #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif ----------------------------------------------------------------------------- -- Builtin names. prelude_mod, main_mod :: ModuleName prelude_mod = ModuleName "Prelude" main_mod = ModuleName "Main" main_name :: Name main_name = Ident "main" unit_con_name :: QName unit_con_name = Special UnitCon tuple_con_name :: Boxed -> Int -> QName tuple_con_name b i = Special (TupleCon b (i+1)) list_cons_name :: QName list_cons_name = Special Cons unboxed_singleton_con_name :: QName unboxed_singleton_con_name = Special UnboxedSingleCon unit_con :: Exp unit_con = Con unit_con_name tuple_con :: Boxed -> Int -> Exp tuple_con b i = Con (tuple_con_name b i) unboxed_singleton_con :: Exp unboxed_singleton_con = Con (unboxed_singleton_con_name) as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name :: Name as_name = Ident "as" qualified_name = Ident "qualified" hiding_name = Ident "hiding" minus_name = Symbol "-" bang_name = Symbol "!" dot_name = Symbol "." star_name = Symbol "*" export_name, safe_name, unsafe_name, threadsafe_name, stdcall_name, ccall_name, cplusplus_name, dotnet_name, jvm_name, js_name, forall_name, family_name :: Name export_name = Ident "export" safe_name = Ident "safe" unsafe_name = Ident "unsafe" threadsafe_name = Ident "threadsafe" stdcall_name = Ident "stdcall" ccall_name = Ident "ccall" cplusplus_name = Ident "cplusplus" dotnet_name = Ident "dotnet" jvm_name = Ident "jvm" js_name = Ident "js" forall_name = Ident "forall" family_name = Ident "family" unit_tycon_name, fun_tycon_name, list_tycon_name, unboxed_singleton_tycon_name :: QName unit_tycon_name = unit_con_name fun_tycon_name = Special FunCon list_tycon_name = Special ListCon unboxed_singleton_tycon_name = Special UnboxedSingleCon tuple_tycon_name :: Boxed -> Int -> QName tuple_tycon_name b i = tuple_con_name b i unit_tycon, fun_tycon, list_tycon, unboxed_singleton_tycon :: Type unit_tycon = TyCon unit_tycon_name fun_tycon = TyCon fun_tycon_name list_tycon = TyCon list_tycon_name unboxed_singleton_tycon = TyCon unboxed_singleton_tycon_name tuple_tycon :: Boxed -> Int -> Type tuple_tycon b i = TyCon (tuple_tycon_name b i) haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Comments.hs0000644000000000000000000000073212204617765022131 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable #-} module Language.Haskell.Exts.Comments where import Language.Haskell.Exts.SrcLoc #ifdef __GLASGOW_HASKELL__ #ifdef BASE4 import Data.Data #else import Data.Generics (Data(..),Typeable(..)) #endif #endif -- | A Haskell comment. The 'Bool' is 'True' if the comment is multi-line, i.e. @{- -}@. data Comment = Comment Bool SrcSpan String #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif haskell-src-exts-1.14.0/src/Language/Haskell/Exts/SrcLoc.hs0000644000000000000000000001334712204617765021537 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.SrcLoc -- Copyright : (c) Niklas Broberg 2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- This module defines various data types representing source location -- information, of varying degree of preciseness. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.SrcLoc where #ifdef __GLASGOW_HASKELL__ #ifdef BASE4 import Data.Data #else import Data.Generics (Data(..),Typeable(..)) #endif #endif -- | A single position in the source. data SrcLoc = SrcLoc { srcFilename :: String , srcLine :: Int , srcColumn :: Int } #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif noLoc :: SrcLoc noLoc = SrcLoc "" (-1) (-1) -- | A portion of the source, spanning one or more lines and zero or more columns. data SrcSpan = SrcSpan { srcSpanFilename :: String , srcSpanStartLine :: Int , srcSpanStartColumn :: Int , srcSpanEndLine :: Int , srcSpanEndColumn :: Int } #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Returns 'srcSpanStartLine' and 'srcSpanStartColumn' in a pair. srcSpanStart :: SrcSpan -> (Int,Int) srcSpanStart x = (srcSpanStartLine x, srcSpanStartColumn x) -- | Returns 'srcSpanEndLine' and 'srcSpanEndColumn' in a pair. srcSpanEnd :: SrcSpan -> (Int,Int) srcSpanEnd x = (srcSpanEndLine x, srcSpanEndColumn x) -- | Combine two locations in the source to denote a span. mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan mkSrcSpan (SrcLoc fn sl sc) (SrcLoc _ el ec) = SrcSpan fn sl sc el ec -- | Merge two source spans into a single span from the start of the first -- to the end of the second. Assumes that the two spans relate to the -- same source file. mergeSrcSpan :: SrcSpan -> SrcSpan -> SrcSpan mergeSrcSpan (SrcSpan fn sl1 sc1 el1 ec1) (SrcSpan _ sl2 sc2 el2 ec2) = let (sl,sc) = min (sl1,sc1) (sl2,sc2) (el,ec) = max (el1,ec1) (el2,ec2) in SrcSpan fn sl sc el ec -- | Test if a given span starts and ends at the same location. isNullSpan :: SrcSpan -> Bool isNullSpan ss = spanSize ss == (0,0) {- isNullSpan ss = srcSpanStartLine ss == srcSpanEndLine ss && srcSpanStartColumn ss >= srcSpanEndColumn ss -} spanSize :: SrcSpan -> (Int, Int) spanSize ss = (srcSpanEndLine ss - srcSpanStartLine ss, max 0 (srcSpanEndColumn ss - srcSpanStartColumn ss)) -- | An entity located in the source. data Loc a = Loc { loc :: SrcSpan , unLoc :: a } deriving (Eq,Ord,Show) -- | A portion of the source, extended with information on the position of entities within the span. data SrcSpanInfo = SrcSpanInfo { srcInfoSpan :: SrcSpan -- , explLayout :: Bool , srcInfoPoints :: [SrcSpan] -- Marks the location of specific entities inside the span } #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Generate a 'SrcSpanInfo' with no positional information for entities. noInfoSpan :: SrcSpan -> SrcSpanInfo noInfoSpan ss = SrcSpanInfo ss [] -- | Generate a 'SrcSpanInfo' with the supplied positional information for entities. infoSpan :: SrcSpan -> [SrcSpan] -> SrcSpanInfo infoSpan = SrcSpanInfo -- | Combine two 'SrcSpanInfo's into one that spans the combined source area of -- the two arguments, leaving positional information blank. combSpanInfo :: SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo combSpanInfo s1 s2 = SrcSpanInfo (mergeSrcSpan (srcInfoSpan s1) (srcInfoSpan s2)) [] -- | Short name for 'combSpanInfo' (<++>) :: SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo (<++>) = combSpanInfo -- | Optionally combine the first argument with the second, -- or return it unchanged if the second argument is 'Nothing'. (<+?>) :: SrcSpanInfo -> Maybe SrcSpanInfo -> SrcSpanInfo a <+?> b = case b of {Nothing -> a; Just b -> a <++> b} -- | Optionally combine the second argument with the first, -- or return it unchanged if the first argument is 'Nothing'. () :: Maybe SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo a b = case a of {Nothing -> b; Just a -> a <++> b} -- | Add more positional information for entities of a span. (<**) :: SrcSpanInfo -> [SrcSpan] -> SrcSpanInfo ss@(SrcSpanInfo {srcInfoPoints = ps}) <** xs = ss {srcInfoPoints = ps ++ xs} -- | Merge two 'SrcSpan's and lift them to a 'SrcInfoSpan' with -- no positional information for entities. (<^^>) :: SrcSpan -> SrcSpan -> SrcSpanInfo a <^^> b = noInfoSpan (mergeSrcSpan a b) infixl 6 <^^> infixl 5 <++> infixl 4 <**, <+?>, -- | A class to work over all kinds of source location information. class SrcInfo si where toSrcInfo :: SrcLoc -> [SrcSpan] -> SrcLoc -> si fromSrcInfo :: SrcSpanInfo -> si getPointLoc :: si -> SrcLoc fileName :: si -> String startLine :: si -> Int startColumn :: si -> Int getPointLoc si = SrcLoc (fileName si) (startLine si) (startColumn si) instance SrcInfo SrcLoc where toSrcInfo s _ _ = s fromSrcInfo si = SrcLoc (fileName si) (startLine si) (startColumn si) fileName = srcFilename startLine = srcLine startColumn = srcColumn instance SrcInfo SrcSpan where toSrcInfo st _ end = mkSrcSpan st end fromSrcInfo = srcInfoSpan fileName = srcSpanFilename startLine = srcSpanStartLine startColumn = srcSpanStartColumn instance SrcInfo SrcSpanInfo where toSrcInfo st pts end = SrcSpanInfo (mkSrcSpan st end) pts fromSrcInfo = id fileName = fileName . srcInfoSpan startLine = startLine . srcInfoSpan startColumn = startColumn . srcInfoSpan haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Pretty.hs0000644000000000000000000020503712204617765021640 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Pretty -- Copyright : (c) Niklas Broberg 2004-2009, -- (c) The GHC Team, Noel Winstanley 1997-2000 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- Pretty printer for Haskell with extensions. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Pretty ( -- * Pretty printing Pretty, prettyPrintStyleMode, prettyPrintWithMode, prettyPrint, -- * Pretty-printing styles (from "Text.PrettyPrint.HughesPJ") P.Style(..), P.style, P.Mode(..), -- * Haskell formatting modes PPHsMode(..), Indent, PPLayout(..), defaultMode) where import Language.Haskell.Exts.Syntax import qualified Language.Haskell.Exts.Annotated.Syntax as A import Language.Haskell.Exts.Annotated.Simplify import qualified Language.Haskell.Exts.ParseSyntax as P import Language.Haskell.Exts.SrcLoc import qualified Text.PrettyPrint as P import Data.List (intersperse) infixl 5 $$$ ----------------------------------------------------------------------------- -- | Varieties of layout we can use. data PPLayout = PPOffsideRule -- ^ classical layout | PPSemiColon -- ^ classical layout made explicit | PPInLine -- ^ inline decls, with newlines between them | PPNoLayout -- ^ everything on a single line deriving Eq type Indent = Int -- | Pretty-printing parameters. -- -- /Note:/ the 'onsideIndent' must be positive and less than all other indents. data PPHsMode = PPHsMode { -- | indentation of a class or instance classIndent :: Indent, -- | indentation of a @do@-expression doIndent :: Indent, -- | indentation of the body of a -- @case@ expression caseIndent :: Indent, -- | indentation of the declarations in a -- @let@ expression letIndent :: Indent, -- | indentation of the declarations in a -- @where@ clause whereIndent :: Indent, -- | indentation added for continuation -- lines that would otherwise be offside onsideIndent :: Indent, -- | blank lines between statements? spacing :: Bool, -- | Pretty-printing style to use layout :: PPLayout, -- | add GHC-style @LINE@ pragmas to output? linePragmas :: Bool } -- | The default mode: pretty-print using the offside rule and sensible -- defaults. defaultMode :: PPHsMode defaultMode = PPHsMode{ classIndent = 8, doIndent = 3, caseIndent = 4, letIndent = 4, whereIndent = 6, onsideIndent = 2, spacing = True, layout = PPOffsideRule, linePragmas = False } -- | Pretty printing monad newtype DocM s a = DocM (s -> a) instance Functor (DocM s) where fmap f xs = do x <- xs; return (f x) instance Monad (DocM s) where (>>=) = thenDocM (>>) = then_DocM return = retDocM {-# INLINE thenDocM #-} {-# INLINE then_DocM #-} {-# INLINE retDocM #-} {-# INLINE unDocM #-} {-# INLINE getPPEnv #-} thenDocM :: DocM s a -> (a -> DocM s b) -> DocM s b thenDocM m k = DocM $ (\s -> case unDocM m $ s of a -> unDocM (k a) $ s) then_DocM :: DocM s a -> DocM s b -> DocM s b then_DocM m k = DocM $ (\s -> case unDocM m $ s of _ -> unDocM k $ s) retDocM :: a -> DocM s a retDocM a = DocM (\_s -> a) unDocM :: DocM s a -> (s -> a) unDocM (DocM f) = f -- all this extra stuff, just for this one function. getPPEnv :: DocM s s getPPEnv = DocM id -- So that pp code still looks the same -- this means we lose some generality though -- | The document type produced by these pretty printers uses a 'PPHsMode' -- environment. type Doc = DocM PPHsMode P.Doc -- | Things that can be pretty-printed, including all the syntactic objects -- in "Language.Haskell.Exts.Syntax" and "Language.Haskell.Exts.Annotated.Syntax". class Pretty a where -- | Pretty-print something in isolation. pretty :: a -> Doc -- | Pretty-print something in a precedence context. prettyPrec :: Int -> a -> Doc pretty = prettyPrec 0 prettyPrec _ = pretty -- The pretty printing combinators empty :: Doc empty = return P.empty nest :: Int -> Doc -> Doc nest i m = m >>= return . P.nest i -- Literals text, ptext :: String -> Doc text = return . P.text ptext = return . P.text char :: Char -> Doc char = return . P.char int :: Int -> Doc int = return . P.int integer :: Integer -> Doc integer = return . P.integer float :: Float -> Doc float = return . P.float double :: Double -> Doc double = return . P.double rational :: Rational -> Doc rational = return . P.rational -- Simple Combining Forms parens, brackets, braces,quotes,doubleQuotes :: Doc -> Doc parens d = d >>= return . P.parens brackets d = d >>= return . P.brackets braces d = d >>= return . P.braces quotes d = d >>= return . P.quotes doubleQuotes d = d >>= return . P.doubleQuotes parensIf :: Bool -> Doc -> Doc parensIf True = parens parensIf False = id -- Constants semi,comma,colon,space,equals :: Doc semi = return P.semi comma = return P.comma colon = return P.colon space = return P.space equals = return P.equals lparen,rparen,lbrack,rbrack,lbrace,rbrace :: Doc lparen = return P.lparen rparen = return P.rparen lbrack = return P.lbrack rbrack = return P.rbrack lbrace = return P.lbrace rbrace = return P.rbrace -- Combinators (<>),(<+>),($$),($+$) :: Doc -> Doc -> Doc aM <> bM = do{a<-aM;b<-bM;return (a P.<> b)} aM <+> bM = do{a<-aM;b<-bM;return (a P.<+> b)} aM $$ bM = do{a<-aM;b<-bM;return (a P.$$ b)} aM $+$ bM = do{a<-aM;b<-bM;return (a P.$+$ b)} hcat,hsep,vcat,sep,cat,fsep,fcat :: [Doc] -> Doc hcat dl = sequence dl >>= return . P.hcat hsep dl = sequence dl >>= return . P.hsep vcat dl = sequence dl >>= return . P.vcat sep dl = sequence dl >>= return . P.sep cat dl = sequence dl >>= return . P.cat fsep dl = sequence dl >>= return . P.fsep fcat dl = sequence dl >>= return . P.fcat -- Some More hang :: Doc -> Int -> Doc -> Doc hang dM i rM = do{d<-dM;r<-rM;return $ P.hang d i r} -- Yuk, had to cut-n-paste this one from Pretty.hs punctuate :: Doc -> [Doc] -> [Doc] punctuate _ [] = [] punctuate p (d1:ds) = go d1 ds where go d [] = [d] go d (e:es) = (d <> p) : go e es -- | render the document with a given style and mode. renderStyleMode :: P.Style -> PPHsMode -> Doc -> String renderStyleMode ppStyle ppMode d = P.renderStyle ppStyle . unDocM d $ ppMode -- | render the document with a given mode. renderWithMode :: PPHsMode -> Doc -> String renderWithMode = renderStyleMode P.style -- | render the document with 'defaultMode'. render :: Doc -> String render = renderWithMode defaultMode -- | pretty-print with a given style and mode. prettyPrintStyleMode :: Pretty a => P.Style -> PPHsMode -> a -> String prettyPrintStyleMode ppStyle ppMode = renderStyleMode ppStyle ppMode . pretty -- | pretty-print with the default style and a given mode. prettyPrintWithMode :: Pretty a => PPHsMode -> a -> String prettyPrintWithMode = prettyPrintStyleMode P.style -- | pretty-print with the default style and 'defaultMode'. prettyPrint :: Pretty a => a -> String prettyPrint = prettyPrintWithMode defaultMode fullRenderWithMode :: PPHsMode -> P.Mode -> Int -> Float -> (P.TextDetails -> a -> a) -> a -> Doc -> a fullRenderWithMode ppMode m i f fn e mD = P.fullRender m i f fn e $ (unDocM mD) ppMode fullRender :: P.Mode -> Int -> Float -> (P.TextDetails -> a -> a) -> a -> Doc -> a fullRender = fullRenderWithMode defaultMode ------------------------- Pretty-Print a Module -------------------- instance Pretty Module where pretty (Module pos m os mbWarn mbExports imp decls) = markLine pos $ myVcat $ map pretty os ++ (if m == ModuleName "" then id else \x -> [topLevel (ppModuleHeader m mbWarn mbExports) x]) (map pretty imp ++ map pretty decls) -------------------------- Module Header ------------------------------ ppModuleHeader :: ModuleName -> Maybe WarningText -> Maybe [ExportSpec] -> Doc ppModuleHeader m mbWarn mbExportList = mySep [ text "module", pretty m, maybePP ppWarnTxt mbWarn, maybePP (parenList . map pretty) mbExportList, text "where"] ppWarnTxt :: WarningText -> Doc ppWarnTxt (DeprText s) = mySep [text "{-# DEPRECATED", text (show s), text "#-}"] ppWarnTxt (WarnText s) = mySep [text "{-# WARNING", text (show s), text "#-}"] instance Pretty ModuleName where pretty (ModuleName modName) = text modName instance Pretty ExportSpec where pretty (EVar name) = pretty name pretty (EAbs name) = pretty name pretty (EThingAll name) = pretty name <> text "(..)" pretty (EThingWith name nameList) = pretty name <> (parenList . map pretty $ nameList) pretty (EModuleContents m) = text "module" <+> pretty m instance Pretty ImportDecl where pretty (ImportDecl pos m qual src mbPkg mbName mbSpecs) = markLine pos $ mySep [text "import", if src then text "{-# SOURCE #-}" else empty, if qual then text "qualified" else empty, maybePP (\s -> text (show s)) mbPkg, pretty m, maybePP (\m' -> text "as" <+> pretty m') mbName, maybePP exports mbSpecs] where exports (b,specList) = if b then text "hiding" <+> specs else specs where specs = parenList . map pretty $ specList instance Pretty ImportSpec where pretty (IVar name) = pretty name pretty (IAbs name) = pretty name pretty (IThingAll name) = pretty name <> text "(..)" pretty (IThingWith name nameList) = pretty name <> (parenList . map pretty $ nameList) ------------------------- Declarations ------------------------------ instance Pretty Decl where pretty (TypeDecl loc name nameList htype) = blankline $ markLine loc $ mySep ( [text "type", pretty name] ++ map pretty nameList ++ [equals, pretty htype]) pretty (DataDecl loc don context name nameList constrList derives) = blankline $ markLine loc $ mySep ( [pretty don, ppContext context, pretty name] ++ map pretty nameList) <+> (myVcat (zipWith (<+>) (equals : repeat (char '|')) (map pretty constrList)) $$$ ppDeriving derives) pretty (GDataDecl loc don context name nameList optkind gadtList derives) = blankline $ markLine loc $ mySep ( [pretty don, ppContext context, pretty name] ++ map pretty nameList ++ ppOptKind optkind ++ [text "where"]) $$$ ppBody classIndent (map pretty gadtList) $$$ ppBody letIndent [ppDeriving derives] pretty (TypeFamDecl loc name nameList optkind) = blankline $ markLine loc $ mySep ([text "type", text "family", pretty name] ++ map pretty nameList ++ ppOptKind optkind) pretty (DataFamDecl loc context name nameList optkind) = blankline $ markLine loc $ mySep ( [text "data", text "family", ppContext context, pretty name] ++ map pretty nameList ++ ppOptKind optkind) pretty (TypeInsDecl loc ntype htype) = blankline $ markLine loc $ mySep [text "type", text "instance", pretty ntype, equals, pretty htype] pretty (DataInsDecl loc don ntype constrList derives) = blankline $ markLine loc $ mySep [pretty don, text "instance", pretty ntype] <+> (myVcat (zipWith (<+>) (equals : repeat (char '|')) (map pretty constrList)) $$$ ppDeriving derives) pretty (GDataInsDecl loc don ntype optkind gadtList derives) = blankline $ markLine loc $ mySep ( [pretty don, text "instance", pretty ntype] ++ ppOptKind optkind ++ [text "where"]) $$$ ppBody classIndent (map pretty gadtList) $$$ ppDeriving derives --m{spacing=False} -- special case for empty class declaration pretty (ClassDecl pos context name nameList fundeps []) = blankline $ markLine pos $ mySep ( [text "class", ppContext context, pretty name] ++ map pretty nameList ++ [ppFunDeps fundeps]) pretty (ClassDecl pos context name nameList fundeps declList) = blankline $ markLine pos $ mySep ( [text "class", ppContext context, pretty name] ++ map pretty nameList ++ [ppFunDeps fundeps, text "where"]) $$$ ppBody classIndent (map pretty declList) -- m{spacing=False} -- special case for empty instance declaration pretty (InstDecl pos context name args []) = blankline $ markLine pos $ mySep ( [text "instance", ppContext context, pretty name] ++ map ppAType args) pretty (InstDecl pos context name args declList) = blankline $ markLine pos $ mySep ( [text "instance", ppContext context, pretty name] ++ map ppAType args ++ [text "where"]) $$$ ppBody classIndent (map pretty declList) pretty (DerivDecl pos context name args) = blankline $ markLine pos $ mySep ( [text "deriving", text "instance", ppContext context, pretty name] ++ map ppAType args) pretty (DefaultDecl pos htypes) = blankline $ markLine pos $ text "default" <+> parenList (map pretty htypes) pretty (SpliceDecl pos splice) = blankline $ markLine pos $ pretty splice pretty (TypeSig pos nameList qualType) = blankline $ markLine pos $ mySep ((punctuate comma . map pretty $ nameList) ++ [text "::", pretty qualType]) pretty (FunBind matches) = do e <- fmap layout getPPEnv case e of PPOffsideRule -> foldr ($$$) empty (map pretty matches) _ -> foldr (\x y -> x <> semi <> y) empty (map pretty matches) pretty (PatBind pos pat optsig rhs whereBinds) = markLine pos $ myFsep [pretty pat, maybePP ppSig optsig, pretty rhs] $$$ ppWhere whereBinds pretty (InfixDecl pos assoc prec opList) = blankline $ markLine pos $ mySep ([pretty assoc, int prec] ++ (punctuate comma . map pretty $ opList)) pretty (ForImp pos cconv saf str name typ) = blankline $ markLine pos $ mySep [text "foreign import", pretty cconv, pretty saf, text (show str), pretty name, text "::", pretty typ] pretty (ForExp pos cconv str name typ) = blankline $ markLine pos $ mySep [text "foreign export", pretty cconv, text (show str), pretty name, text "::", pretty typ] pretty (RulePragmaDecl pos rules) = blankline $ markLine pos $ myVcat $ text "{-# RULES" : map pretty rules ++ [text " #-}"] pretty (DeprPragmaDecl pos deprs) = blankline $ markLine pos $ myVcat $ text "{-# DEPRECATED" : map ppWarnDepr deprs ++ [text " #-}"] pretty (WarnPragmaDecl pos deprs) = blankline $ markLine pos $ myVcat $ text "{-# WARNING" : map ppWarnDepr deprs ++ [text " #-}"] pretty (InlineSig pos inl activ name) = blankline $ markLine pos $ mySep [text (if inl then "{-# INLINE" else "{-# NOINLINE"), pretty activ, pretty name, text "#-}"] pretty (InlineConlikeSig pos activ name) = blankline $ markLine pos $ mySep [text "{-# INLINE_CONLIKE", pretty activ, pretty name, text "#-}"] pretty (SpecSig pos activ name types) = blankline $ markLine pos $ mySep $ [text "{-# SPECIALISE", pretty activ, pretty name, text "::"] ++ punctuate comma (map pretty types) ++ [text "#-}"] pretty (SpecInlineSig pos inl activ name types) = blankline $ markLine pos $ mySep $ [text "{-# SPECIALISE", text (if inl then "INLINE" else "NOINLINE"), pretty activ, pretty name, text "::"] ++ (punctuate comma $ map pretty types) ++ [text "#-}"] pretty (InstSig pos context name args) = blankline $ markLine pos $ mySep $ [text "{-# SPECIALISE", text "instance", ppContext context, pretty name] ++ map ppAType args ++ [text "#-}"] pretty (AnnPragma pos ann) = blankline $ markLine pos $ mySep $ [text "{-# ANN", pretty ann, text "#-}"] instance Pretty Annotation where pretty (Ann n e) = myFsep [pretty n, pretty e] pretty (TypeAnn n e) = myFsep [text "type", pretty n, pretty e] pretty (ModuleAnn e) = myFsep [text "module", pretty e] instance Pretty DataOrNew where pretty DataType = text "data" pretty NewType = text "newtype" instance Pretty Assoc where pretty AssocNone = text "infix" pretty AssocLeft = text "infixl" pretty AssocRight = text "infixr" instance Pretty Match where pretty (Match pos f ps optsig rhs whereBinds) = markLine pos $ myFsep (lhs ++ [maybePP ppSig optsig, pretty rhs]) $$$ ppWhere whereBinds where lhs = case ps of l:r:ps' | isSymbolName f -> let hd = [pretty l, ppName f, pretty r] in if null ps' then hd else parens (myFsep hd) : map (prettyPrec 2) ps' _ -> pretty f : map (prettyPrec 2) ps ppWhere :: Binds -> Doc ppWhere (BDecls []) = empty ppWhere (BDecls l) = nest 2 (text "where" $$$ ppBody whereIndent (map pretty l)) ppWhere (IPBinds b) = nest 2 (text "where" $$$ ppBody whereIndent (map pretty b)) ppSig :: Type -> Doc ppSig t = text "::" <+> pretty t instance Pretty ClassDecl where pretty (ClsDecl decl) = pretty decl pretty (ClsDataFam loc context name nameList optkind) = markLine loc $ mySep ( [text "data", ppContext context, pretty name] ++ map pretty nameList ++ ppOptKind optkind) pretty (ClsTyFam loc name nameList optkind) = markLine loc $ mySep ( [text "type", pretty name] ++ map pretty nameList ++ ppOptKind optkind) pretty (ClsTyDef loc ntype htype) = markLine loc $ mySep [text "type", pretty ntype, equals, pretty htype] instance Pretty InstDecl where pretty (InsDecl decl) = pretty decl pretty (InsType loc ntype htype) = markLine loc $ mySep [text "type", pretty ntype, equals, pretty htype] pretty (InsData loc don ntype constrList derives) = markLine loc $ mySep [pretty don, pretty ntype] <+> (myVcat (zipWith (<+>) (equals : repeat (char '|')) (map pretty constrList)) $$$ ppDeriving derives) pretty (InsGData loc don ntype optkind gadtList derives) = markLine loc $ mySep ( [pretty don, pretty ntype] ++ ppOptKind optkind ++ [text "where"]) $$$ ppBody classIndent (map pretty gadtList) $$$ ppDeriving derives -- pretty (InsInline loc inl activ name) = -- markLine loc $ -- mySep [text (if inl then "{-# INLINE" else "{-# NOINLINE"), pretty activ, pretty name, text "#-}"] ------------------------- FFI stuff ------------------------------------- instance Pretty Safety where pretty PlayRisky = text "unsafe" pretty (PlaySafe b) = text $ if b then "threadsafe" else "safe" pretty PlayInterruptible = text "interruptible" instance Pretty CallConv where pretty StdCall = text "stdcall" pretty CCall = text "ccall" pretty CPlusPlus = text "cplusplus" pretty DotNet = text "dotnet" pretty Jvm = text "jvm" pretty Js = text "js" ------------------------- Pragmas --------------------------------------- ppWarnDepr :: ([Name], String) -> Doc ppWarnDepr (names, txt) = mySep $ (punctuate comma $ map pretty names) ++ [text $ show txt] instance Pretty Rule where pretty (Rule tag activ rvs rhs lhs) = mySep $ [text $ show tag, pretty activ, maybePP ppRuleVars rvs, pretty rhs, char '=', pretty lhs] ppRuleVars :: [RuleVar] -> Doc ppRuleVars [] = empty ppRuleVars rvs = mySep $ text "forall" : map pretty rvs ++ [char '.'] instance Pretty Activation where pretty AlwaysActive = empty pretty (ActiveFrom i) = char '[' <> int i <> char ']' pretty (ActiveUntil i) = text "[~" <> int i <> char ']' instance Pretty RuleVar where pretty (RuleVar n) = pretty n pretty (TypedRuleVar n t) = parens $ mySep [pretty n, text "::", pretty t] instance Pretty ModulePragma where pretty (LanguagePragma _ ns) = myFsep $ text "{-# LANGUAGE" : punctuate (char ',') (map pretty ns) ++ [text "#-}"] pretty (OptionsPragma _ (Just tool) s) = myFsep $ [text "{-# OPTIONS_" <> pretty tool, text s, text "#-}"] pretty (OptionsPragma _ _ s) = myFsep $ [text "{-# OPTIONS", text s, text "#-}"] pretty (AnnModulePragma _ ann) = myFsep $ [text "{-# ANN", pretty ann, text "#-}"] instance Pretty Tool where pretty (UnknownTool s) = text s pretty t = text $ show t ------------------------- Data & Newtype Bodies ------------------------- instance Pretty QualConDecl where pretty (QualConDecl _pos tvs ctxt con) = myFsep [ppForall (Just tvs), ppContext ctxt, pretty con] instance Pretty GadtDecl where pretty (GadtDecl _pos name ty) = myFsep [pretty name, text "::", pretty ty] instance Pretty ConDecl where pretty (RecDecl name fieldList) = pretty name <> (braceList . map ppField $ fieldList) {- pretty (ConDecl name@(Symbol _) [l, r]) = myFsep [prettyPrec prec_btype l, ppName name, prettyPrec prec_btype r] -} pretty (ConDecl name typeList) = mySep $ ppName name : map (prettyPrec prec_atype) typeList pretty (InfixConDecl l name r) = myFsep [prettyPrec prec_btype l, ppNameInfix name, prettyPrec prec_btype r] ppField :: ([Name],BangType) -> Doc ppField (names, ty) = myFsepSimple $ (punctuate comma . map pretty $ names) ++ [text "::", pretty ty] instance Pretty BangType where prettyPrec _ (BangedTy ty) = char '!' <> ppAType ty prettyPrec p (UnBangedTy ty) = prettyPrec p ty prettyPrec p (UnpackedTy ty) = text "{-# UNPACK #-}" <+> char '!' <> prettyPrec p ty ppDeriving :: [Deriving] -> Doc ppDeriving [] = empty ppDeriving [(d, [])] = text "deriving" <+> ppQName d ppDeriving ds = text "deriving" <+> parenList (map ppDer ds) where ppDer :: (QName, [Type]) -> Doc ppDer (n, ts) = mySep (pretty n : map pretty ts) ------------------------- Types ------------------------- ppBType :: Type -> Doc ppBType = prettyPrec prec_btype ppAType :: Type -> Doc ppAType = prettyPrec prec_atype -- precedences for types prec_btype, prec_atype :: Int prec_btype = 1 -- left argument of ->, -- or either argument of an infix data constructor prec_atype = 2 -- argument of type or data constructor, or of a class instance Pretty Type where prettyPrec p (TyForall mtvs ctxt htype) = parensIf (p > 0) $ myFsep [ppForall mtvs, ppContext ctxt, pretty htype] prettyPrec p (TyFun a b) = parensIf (p > 0) $ myFsep [ppBType a, text "->", pretty b] prettyPrec _ (TyTuple bxd l) = let ds = map pretty l in case bxd of Boxed -> parenList ds Unboxed -> hashParenList ds prettyPrec _ (TyList t) = brackets $ pretty t prettyPrec p (TyApp a b) = {- | a == list_tycon = brackets $ pretty b -- special case | otherwise = -} parensIf (p > prec_btype) $ myFsep [pretty a, ppAType b] prettyPrec _ (TyVar name) = pretty name prettyPrec _ (TyCon name) = pretty name prettyPrec _ (TyParen t) = parens (pretty t) -- prettyPrec _ (TyPred asst) = pretty asst prettyPrec _ (TyInfix a op b) = myFsep [pretty a, ppQNameInfix op, pretty b] prettyPrec _ (TyKind t k) = parens (myFsep [pretty t, text "::", pretty k]) instance Pretty TyVarBind where pretty (KindedVar var kind) = parens $ myFsep [pretty var, text "::", pretty kind] pretty (UnkindedVar var) = pretty var ppForall :: Maybe [TyVarBind] -> Doc ppForall Nothing = empty ppForall (Just []) = empty ppForall (Just vs) = myFsep (text "forall" : map pretty vs ++ [char '.']) ---------------------------- Kinds ---------------------------- instance Pretty Kind where prettyPrec _ KindStar = text "*" prettyPrec _ KindBang = text "!" prettyPrec n (KindFn a b) = parensIf (n > 0) $ myFsep [prettyPrec 1 a, text "->", pretty b] prettyPrec _ (KindParen k) = parens $ pretty k prettyPrec _ (KindVar n) = pretty n ppOptKind :: Maybe Kind -> [Doc] ppOptKind Nothing = [] ppOptKind (Just k) = [text "::", pretty k] ------------------- Functional Dependencies ------------------- instance Pretty FunDep where pretty (FunDep from to) = myFsep $ map pretty from ++ [text "->"] ++ map pretty to ppFunDeps :: [FunDep] -> Doc ppFunDeps [] = empty ppFunDeps fds = myFsep $ (char '|':) . punctuate comma . map pretty $ fds ------------------------- Expressions ------------------------- instance Pretty Rhs where pretty (UnGuardedRhs e) = equals <+> pretty e pretty (GuardedRhss guardList) = myVcat . map pretty $ guardList instance Pretty GuardedRhs where pretty (GuardedRhs _pos guards ppBody) = myFsep $ [char '|'] ++ (punctuate comma . map pretty $ guards) ++ [equals, pretty ppBody] instance Pretty Literal where pretty (Int i) = integer i pretty (Char c) = text (show c) pretty (String s) = text (show s) pretty (Frac r) = double (fromRational r) -- GHC unboxed literals: pretty (PrimChar c) = text (show c) <> char '#' pretty (PrimString s) = text (show s) <> char '#' pretty (PrimInt i) = integer i <> char '#' pretty (PrimWord w) = integer w <> text "##" pretty (PrimFloat r) = float (fromRational r) <> char '#' pretty (PrimDouble r) = double (fromRational r) <> text "##" instance Pretty Exp where prettyPrec _ (Lit l) = pretty l -- lambda stuff prettyPrec p (InfixApp a op b) = parensIf (p > 2) $ myFsep [prettyPrec 2 a, pretty op, prettyPrec 1 b] prettyPrec p (NegApp e) = parensIf (p > 0) $ char '-' <> prettyPrec 4 e prettyPrec p (App a b) = parensIf (p > 3) $ myFsep [prettyPrec 3 a, prettyPrec 4 b] prettyPrec p (Lambda _loc patList ppBody) = parensIf (p > 1) $ myFsep $ char '\\' : map (prettyPrec 2) patList ++ [text "->", pretty ppBody] -- keywords -- two cases for lets prettyPrec p (Let (BDecls declList) letBody) = parensIf (p > 1) $ ppLetExp declList letBody prettyPrec p (Let (IPBinds bindList) letBody) = parensIf (p > 1) $ ppLetExp bindList letBody prettyPrec p (If cond thenexp elsexp) = parensIf (p > 1) $ myFsep [text "if", pretty cond, text "then", pretty thenexp, text "else", pretty elsexp] prettyPrec p (Case cond altList) = parensIf (p > 1) $ myFsep [text "case", pretty cond, text "of"] $$$ ppBody caseIndent (map pretty altList) prettyPrec p (Do stmtList) = parensIf (p > 1) $ text "do" $$$ ppBody doIndent (map pretty stmtList) prettyPrec p (MDo stmtList) = parensIf (p > 1) $ text "mdo" $$$ ppBody doIndent (map pretty stmtList) -- Constructors & Vars prettyPrec _ (Var name) = pretty name prettyPrec _ (IPVar ipname) = pretty ipname prettyPrec _ (Con name) = pretty name prettyPrec _ (Tuple bxd expList) = let ds = map pretty expList in case bxd of Boxed -> parenList ds Unboxed -> hashParenList ds prettyPrec _ (TupleSection bxd mExpList) = let ds = map (maybePP pretty) mExpList in case bxd of Boxed -> parenList ds Unboxed -> hashParenList ds -- weird stuff prettyPrec _ (Paren e) = parens . pretty $ e prettyPrec _ (LeftSection e op) = parens (pretty e <+> pretty op) prettyPrec _ (RightSection op e) = parens (pretty op <+> pretty e) prettyPrec _ (RecConstr c fieldList) = pretty c <> (braceList . map pretty $ fieldList) prettyPrec _ (RecUpdate e fieldList) = pretty e <> (braceList . map pretty $ fieldList) -- Lists prettyPrec _ (List list) = bracketList . punctuate comma . map pretty $ list prettyPrec _ (EnumFrom e) = bracketList [pretty e, text ".."] prettyPrec _ (EnumFromTo from to) = bracketList [pretty from, text "..", pretty to] prettyPrec _ (EnumFromThen from thenE) = bracketList [pretty from <> comma, pretty thenE, text ".."] prettyPrec _ (EnumFromThenTo from thenE to) = bracketList [pretty from <> comma, pretty thenE, text "..", pretty to] prettyPrec _ (ListComp e qualList) = bracketList ([pretty e, char '|'] ++ (punctuate comma . map pretty $ qualList)) prettyPrec _ (ParComp e qualLists) = bracketList (punctuate (char '|') $ pretty e : (map (hsep . punctuate comma . map pretty) $ qualLists)) prettyPrec p (ExpTypeSig _pos e ty) = parensIf (p > 0) $ myFsep [pretty e, text "::", pretty ty] -- Template Haskell prettyPrec _ (BracketExp b) = pretty b prettyPrec _ (SpliceExp s) = pretty s prettyPrec _ (TypQuote t) = text "\'\'" <> pretty t prettyPrec _ (VarQuote x) = text "\'" <> pretty x prettyPrec _ (QuasiQuote n qt) = text ("[" ++ n ++ "|" ++ qt ++ "|]") -- Hsx prettyPrec _ (XTag _ n attrs mattr cs) = let ax = maybe [] (return . pretty) mattr in hcat $ (myFsep $ (char '<' <> pretty n): map pretty attrs ++ ax ++ [char '>']): map pretty cs ++ [myFsep $ [text " pretty n, char '>']] prettyPrec _ (XETag _ n attrs mattr) = let ax = maybe [] (return . pretty) mattr in myFsep $ (char '<' <> pretty n): map pretty attrs ++ ax ++ [text "/>"] prettyPrec _ (XPcdata s) = text s prettyPrec _ (XExpTag e) = myFsep $ [text "<%", pretty e, text "%>"] prettyPrec _ (XChildTag _ cs) = myFsep $ text "<%>" : map pretty cs ++ [text ""] -- Pragmas prettyPrec p (CorePragma s e) = myFsep $ map text ["{-# CORE", show s, "#-}"] ++ [pretty e] prettyPrec _ (SCCPragma s e) = myFsep $ map text ["{-# SCC", show s, "#-}"] ++ [pretty e] prettyPrec _ (GenPragma s (a,b) (c,d) e) = myFsep $ [text "{-# GENERATED", text $ show s, int a, char ':', int b, char '-', int c, char ':', int d, text "#-}", pretty e] -- Arrows prettyPrec p (Proc _ pat e) = parensIf (p > 1) $ myFsep $ [text "proc", pretty pat, text "->", pretty e] prettyPrec p (LeftArrApp l r) = parensIf (p > 0) $ myFsep $ [pretty l, text "-<", pretty r] prettyPrec p (RightArrApp l r) = parensIf (p > 0) $ myFsep $ [pretty l, text ">-", pretty r] prettyPrec p (LeftArrHighApp l r) = parensIf (p > 0) $ myFsep $ [pretty l, text "-<<", pretty r] prettyPrec p (RightArrHighApp l r) = parensIf (p > 0) $ myFsep $ [pretty l, text ">>-", pretty r] instance Pretty XAttr where pretty (XAttr n v) = myFsep [pretty n, char '=', pretty v] instance Pretty XName where pretty (XName n) = text n pretty (XDomName d n) = text d <> char ':' <> text n --ppLetExp :: [Decl] -> Exp -> Doc ppLetExp l b = myFsep [text "let" <+> ppBody letIndent (map pretty l), text "in", pretty b] ppWith binds = nest 2 (text "with" $$$ ppBody withIndent (map pretty binds)) withIndent = whereIndent --------------------- Template Haskell ------------------------- instance Pretty Bracket where pretty (ExpBracket e) = ppBracket "[|" e pretty (PatBracket p) = ppBracket "[p|" p pretty (TypeBracket t) = ppBracket "[t|" t pretty (DeclBracket d) = myFsep $ text "[d|" : map pretty d ++ [text "|]"] ppBracket o x = myFsep [text o, pretty x, text "|]"] instance Pretty Splice where pretty (IdSplice s) = char '$' <> text s pretty (ParenSplice e) = myFsep [text "$(", pretty e, char ')'] ------------------------- Patterns ----------------------------- instance Pretty Pat where prettyPrec _ (PVar name) = pretty name prettyPrec _ (PLit lit) = pretty lit prettyPrec p (PNeg pat) = parensIf (p > 0) $ myFsep [char '-', pretty pat] prettyPrec p (PInfixApp a op b) = parensIf (p > 0) $ myFsep [prettyPrec 1 a, pretty (QConOp op), prettyPrec 1 b] prettyPrec p (PApp n ps) = parensIf (p > 1 && not (null ps)) $ myFsep (pretty n : map (prettyPrec 2) ps) prettyPrec _ (PTuple bxd ps) = let ds = map pretty ps in case bxd of Boxed -> parenList ds Unboxed -> hashParenList ds prettyPrec _ (PList ps) = bracketList . punctuate comma . map pretty $ ps prettyPrec _ (PParen pat) = parens . pretty $ pat prettyPrec _ (PRec c fields) = pretty c <> (braceList . map pretty $ fields) -- special case that would otherwise be buggy prettyPrec _ (PAsPat name (PIrrPat pat)) = myFsep [pretty name <> char '@', char '~' <> prettyPrec 2 pat] prettyPrec _ (PAsPat name pat) = hcat [pretty name, char '@', prettyPrec 2 pat] prettyPrec _ PWildCard = char '_' prettyPrec _ (PIrrPat pat) = char '~' <> prettyPrec 2 pat prettyPrec p (PatTypeSig _pos pat ty) = parensIf (p > 0) $ myFsep [pretty pat, text "::", pretty ty] prettyPrec p (PViewPat e pat) = parensIf (p > 0) $ myFsep [pretty e, text "->", pretty pat] prettyPrec p (PNPlusK n k) = parensIf (p > 0) $ myFsep [pretty n, text "+", text $ show k] -- HaRP prettyPrec _ (PRPat rs) = bracketList . punctuate comma . map pretty $ rs -- Hsx prettyPrec _ (PXTag _ n attrs mattr cp) = let ap = maybe [] (return . pretty) mattr in hcat $ -- TODO: should not introduce blanks (myFsep $ (char '<' <> pretty n): map pretty attrs ++ ap ++ [char '>']): map pretty cp ++ [myFsep $ [text " pretty n, char '>']] prettyPrec _ (PXETag _ n attrs mattr) = let ap = maybe [] (return . pretty) mattr in myFsep $ (char '<' <> pretty n): map pretty attrs ++ ap ++ [text "/>"] prettyPrec _ (PXPcdata s) = text s prettyPrec _ (PXPatTag p) = myFsep $ [text "<%", pretty p, text "%>"] prettyPrec _ (PXRPats ps) = myFsep $ text "<[" : map pretty ps ++ [text "%>"] -- Generics prettyPrec _ (PExplTypeArg qn t) = myFsep [pretty qn, text "{|", pretty t, text "|}"] -- BangPatterns prettyPrec _ (PBangPat pat) = text "!" <> prettyPrec 2 pat instance Pretty PXAttr where pretty (PXAttr n p) = myFsep [pretty n, char '=', pretty p] instance Pretty PatField where pretty (PFieldPat name pat) = myFsep [pretty name, equals, pretty pat] pretty (PFieldPun name) = pretty name pretty (PFieldWildcard) = text ".." --------------------- Regular Patterns ------------------------- instance Pretty RPat where pretty (RPOp r op) = pretty r <> pretty op pretty (RPEither r1 r2) = parens . myFsep $ [pretty r1, char '|', pretty r2] pretty (RPSeq rs) = myFsep $ text "(/" : map pretty rs ++ [text "/)"] pretty (RPGuard r gs) = myFsep $ text "(|" : pretty r : char '|' : map pretty gs ++ [text "|)"] -- special case that would otherwise be buggy pretty (RPCAs n (RPPat (PIrrPat p))) = myFsep [pretty n <> text "@:", char '~' <> pretty p] pretty (RPCAs n r) = hcat [pretty n, text "@:", pretty r] -- special case that would otherwise be buggy pretty (RPAs n (RPPat (PIrrPat p))) = myFsep [pretty n <> text "@:", char '~' <> pretty p] pretty (RPAs n r) = hcat [pretty n, char '@', pretty r] pretty (RPPat p) = pretty p pretty (RPParen rp) = parens . pretty $ rp instance Pretty RPatOp where pretty RPStar = char '*' pretty RPStarG = text "*!" pretty RPPlus = char '+' pretty RPPlusG = text "+!" pretty RPOpt = char '?' pretty RPOptG = text "?!" ------------------------- Case bodies ------------------------- instance Pretty Alt where pretty (Alt _pos e gAlts binds) = pretty e <+> pretty gAlts $$$ ppWhere binds instance Pretty GuardedAlts where pretty (UnGuardedAlt e) = text "->" <+> pretty e pretty (GuardedAlts altList) = myVcat . map pretty $ altList instance Pretty GuardedAlt where pretty (GuardedAlt _pos guards body) = myFsep $ char '|': (punctuate comma . map pretty $ guards) ++ [text "->", pretty body] ------------------------- Statements in monads, guards & list comprehensions ----- instance Pretty Stmt where pretty (Generator _loc e from) = pretty e <+> text "<-" <+> pretty from pretty (Qualifier e) = pretty e -- two cases for lets pretty (LetStmt (BDecls declList)) = ppLetStmt declList pretty (LetStmt (IPBinds bindList)) = ppLetStmt bindList pretty (RecStmt stmtList) = text "rec" $$$ ppBody letIndent (map pretty stmtList) ppLetStmt l = text "let" $$$ ppBody letIndent (map pretty l) instance Pretty QualStmt where pretty (QualStmt s) = pretty s pretty (ThenTrans f) = myFsep $ [text "then", pretty f] pretty (ThenBy f e) = myFsep $ [text "then", pretty f, text "by", pretty e] pretty (GroupBy e) = myFsep $ [text "then", text "group", text "by", pretty e] pretty (GroupUsing f) = myFsep $ [text "then", text "group", text "using", pretty f] pretty (GroupByUsing e f) = myFsep $ [text "then", text "group", text "by", pretty e, text "using", pretty f] ------------------------- Record updates instance Pretty FieldUpdate where pretty (FieldUpdate name e) = myFsep [pretty name, equals, pretty e] pretty (FieldPun name) = pretty name pretty (FieldWildcard) = text ".." ------------------------- Names ------------------------- instance Pretty QOp where pretty (QVarOp n) = ppQNameInfix n pretty (QConOp n) = ppQNameInfix n ppQNameInfix :: QName -> Doc ppQNameInfix name | isSymbolName (getName name) = ppQName name | otherwise = char '`' <> ppQName name <> char '`' instance Pretty QName where pretty name = case name of UnQual (Symbol ('#':_)) -> char '(' <+> ppQName name <+> char ')' _ -> parensIf (isSymbolName (getName name)) (ppQName name) ppQName :: QName -> Doc ppQName (UnQual name) = ppName name ppQName (Qual m name) = pretty m <> char '.' <> ppName name ppQName (Special sym) = text (specialName sym) instance Pretty Op where pretty (VarOp n) = ppNameInfix n pretty (ConOp n) = ppNameInfix n ppNameInfix :: Name -> Doc ppNameInfix name | isSymbolName name = ppName name | otherwise = char '`' <> ppName name <> char '`' instance Pretty Name where pretty name = case name of Symbol ('#':_) -> char '(' <+> ppName name <+> char ')' _ -> parensIf (isSymbolName name) (ppName name) ppName :: Name -> Doc ppName (Ident s) = text s ppName (Symbol s) = text s instance Pretty IPName where pretty (IPDup s) = char '?' <> text s pretty (IPLin s) = char '%' <> text s instance Pretty IPBind where pretty (IPBind _loc ipname exp) = myFsep [pretty ipname, equals, pretty exp] instance Pretty CName where pretty (VarName n) = pretty n pretty (ConName n) = pretty n instance Pretty SpecialCon where pretty sc = text $ specialName sc isSymbolName :: Name -> Bool isSymbolName (Symbol _) = True isSymbolName _ = False getName :: QName -> Name getName (UnQual s) = s getName (Qual _ s) = s getName (Special Cons) = Symbol ":" getName (Special FunCon) = Symbol "->" getName (Special s) = Ident (specialName s) specialName :: SpecialCon -> String specialName UnitCon = "()" specialName ListCon = "[]" specialName FunCon = "->" specialName (TupleCon b n) = "(" ++ hash ++ replicate (n-1) ',' ++ hash ++ ")" where hash = if b == Unboxed then "#" else "" specialName Cons = ":" specialName UnboxedSingleCon = "(# #)" ppContext :: Context -> Doc ppContext [] = empty ppContext context = mySep [parenList (map pretty context), text "=>"] -- hacked for multi-parameter type classes instance Pretty Asst where pretty (ClassA a ts) = myFsep $ ppQName a : map ppAType ts pretty (InfixA a op b) = myFsep $ [pretty a, ppQNameInfix op, pretty b] pretty (IParam i t) = myFsep $ [pretty i, text "::", pretty t] pretty (EqualP t1 t2) = myFsep $ [pretty t1, text "~", pretty t2] -- Pretty print a source location, useful for printing out error messages instance Pretty SrcLoc where pretty srcLoc = return $ P.hsep [ colonFollow (P.text $ srcFilename srcLoc) , colonFollow (P.int $ srcLine srcLoc) , P.int $ srcColumn srcLoc ] colonFollow p = P.hcat [ p, P.colon ] instance Pretty SrcSpan where pretty srcSpan = return $ P.hsep [ colonFollow (P.text $ srcSpanFilename srcSpan) , P.hcat [ P.text "(" , P.int $ srcSpanStartLine srcSpan , P.colon , P.int $ srcSpanStartColumn srcSpan , P.text ")" ] , P.text "-" , P.hcat [ P.text "(" , P.int $ srcSpanEndLine srcSpan , P.colon , P.int $ srcSpanEndColumn srcSpan , P.text ")" ] ] --------------------------------------------------------------------- -- Annotated version ------------------------- Pretty-Print a Module -------------------- instance SrcInfo pos => Pretty (A.Module pos) where pretty (A.Module pos mbHead os imp decls) = markLine pos $ myVcat $ map pretty os ++ (case mbHead of Nothing -> id Just h -> \x -> [topLevel (pretty h) x]) (map pretty imp ++ map pretty decls) pretty (A.XmlPage pos _mn os n attrs mattr cs) = markLine pos $ myVcat $ map pretty os ++ [let ax = maybe [] (return . pretty) mattr in hcat $ (myFsep $ (char '<' <> pretty n): map pretty attrs ++ ax ++ [char '>']): map pretty cs ++ [myFsep $ [text " pretty n, char '>']]] pretty (A.XmlHybrid pos mbHead os imp decls n attrs mattr cs) = markLine pos $ myVcat $ map pretty os ++ [text "<%"] ++ (case mbHead of Nothing -> id Just h -> \x -> [topLevel (pretty h) x]) (map pretty imp ++ map pretty decls ++ [let ax = maybe [] (return . pretty) mattr in hcat $ (myFsep $ (char '<' <> pretty n): map pretty attrs ++ ax ++ [char '>']): map pretty cs ++ [myFsep $ [text " pretty n, char '>']]]) -------------------------- Module Header ------------------------------ instance Pretty (A.ModuleHead l) where pretty (A.ModuleHead _ m mbWarn mbExportList) = mySep [ text "module", pretty m, maybePP pretty mbWarn, maybePP pretty mbExportList, text "where"] instance Pretty (A.WarningText l) where pretty = ppWarnTxt. sWarningText instance Pretty (A.ModuleName l) where pretty = pretty . sModuleName instance Pretty (A.ExportSpecList l) where pretty (A.ExportSpecList _ especs) = parenList $ map pretty especs instance Pretty (A.ExportSpec l) where pretty = pretty . sExportSpec instance SrcInfo pos => Pretty (A.ImportDecl pos) where pretty = pretty . sImportDecl instance Pretty (A.ImportSpecList l) where pretty (A.ImportSpecList _ b ispecs) = (if b then text "hiding" else empty) <+> parenList (map pretty ispecs) instance Pretty (A.ImportSpec l) where pretty = pretty . sImportSpec ------------------------- Declarations ------------------------------ instance SrcInfo pos => Pretty (A.Decl pos) where pretty = pretty . sDecl instance Pretty (A.DeclHead l) where pretty (A.DHead l n tvs) = mySep (pretty n : map pretty tvs) pretty (A.DHInfix l tva n tvb) = mySep [pretty tva, pretty n, pretty tvb] pretty (A.DHParen l dh) = parens (pretty dh) instance Pretty (A.InstHead l) where pretty (A.IHead l qn ts) = mySep (pretty qn : map pretty ts) pretty (A.IHInfix l ta qn tb) = mySep [pretty ta, pretty qn, pretty tb] pretty (A.IHParen l ih) = parens (pretty ih) instance Pretty (A.DataOrNew l) where pretty = pretty . sDataOrNew instance Pretty (A.Assoc l) where pretty = pretty . sAssoc instance SrcInfo pos => Pretty (A.Match pos) where pretty = pretty . sMatch instance SrcInfo loc => Pretty (A.ClassDecl loc) where pretty = pretty . sClassDecl instance SrcInfo loc => Pretty (A.InstDecl loc) where pretty = pretty . sInstDecl ------------------------- FFI stuff ------------------------------------- instance Pretty (A.Safety l) where pretty = pretty . sSafety instance Pretty (A.CallConv l) where pretty = pretty . sCallConv ------------------------- Pragmas --------------------------------------- instance SrcInfo loc => Pretty (A.Rule loc) where pretty = pretty . sRule instance Pretty (A.Activation l) where pretty = pretty . sActivation instance Pretty (A.RuleVar l) where pretty = pretty . sRuleVar instance SrcInfo loc => Pretty (A.ModulePragma loc) where pretty (A.LanguagePragma _ ns) = myFsep $ text "{-# LANGUAGE" : punctuate (char ',') (map pretty ns) ++ [text "#-}"] pretty (A.OptionsPragma _ (Just tool) s) = myFsep $ [text "{-# OPTIONS_" <> pretty tool, text s, text "#-}"] pretty (A.OptionsPragma _ _ s) = myFsep $ [text "{-# OPTIONS", text s, text "#-}"] pretty (A.AnnModulePragma _ ann) = myFsep $ [text "{-# ANN", pretty ann, text "#-}"] instance SrcInfo loc => Pretty (A.Annotation loc) where pretty = pretty . sAnnotation ------------------------- Data & Newtype Bodies ------------------------- instance Pretty (A.QualConDecl l) where pretty (A.QualConDecl _pos mtvs ctxt con) = myFsep [ppForall (fmap (map sTyVarBind) mtvs), ppContext $ maybe [] sContext ctxt, pretty con] instance Pretty (A.GadtDecl l) where pretty (A.GadtDecl _pos name ty) = myFsep [pretty name, text "::", pretty ty] instance Pretty (A.ConDecl l) where pretty = pretty . sConDecl instance Pretty (A.FieldDecl l) where pretty (A.FieldDecl _ names ty) = myFsepSimple $ (punctuate comma . map pretty $ names) ++ [text "::", pretty ty] instance Pretty (A.BangType l) where pretty = pretty . sBangType instance Pretty (A.Deriving l) where pretty (A.Deriving _ []) = text "deriving" <+> parenList [] pretty (A.Deriving _ [A.IHead _ d []]) = text "deriving" <+> pretty d pretty (A.Deriving _ ihs) = text "deriving" <+> parenList (map pretty ihs) ------------------------- Types ------------------------- instance Pretty (A.Type l) where pretty = pretty . sType instance Pretty (A.TyVarBind l) where pretty = pretty . sTyVarBind ---------------------------- Kinds ---------------------------- instance Pretty (A.Kind l) where pretty = pretty . sKind ------------------- Functional Dependencies ------------------- instance Pretty (A.FunDep l) where pretty = pretty . sFunDep ------------------------- Expressions ------------------------- instance SrcInfo loc => Pretty (A.Rhs loc) where pretty = pretty . sRhs instance SrcInfo loc => Pretty (A.GuardedRhs loc) where pretty = pretty . sGuardedRhs instance Pretty (A.Literal l) where pretty = pretty . sLiteral instance SrcInfo loc => Pretty (A.Exp loc) where pretty = pretty . sExp instance SrcInfo loc => Pretty (A.XAttr loc) where pretty = pretty . sXAttr instance Pretty (A.XName l) where pretty = pretty . sXName --------------------- Template Haskell ------------------------- instance SrcInfo loc => Pretty (A.Bracket loc) where pretty = pretty . sBracket instance SrcInfo loc => Pretty (A.Splice loc) where pretty = pretty . sSplice ------------------------- Patterns ----------------------------- instance SrcInfo loc => Pretty (A.Pat loc) where pretty = pretty . sPat instance SrcInfo loc => Pretty (A.PXAttr loc) where pretty = pretty . sPXAttr instance SrcInfo loc => Pretty (A.PatField loc) where pretty = pretty . sPatField --------------------- Regular Patterns ------------------------- instance SrcInfo loc => Pretty (A.RPat loc) where pretty = pretty . sRPat instance Pretty (A.RPatOp l) where pretty = pretty . sRPatOp ------------------------- Case bodies ------------------------- instance SrcInfo loc => Pretty (A.Alt loc) where pretty = pretty . sAlt instance SrcInfo loc => Pretty (A.GuardedAlts loc) where pretty = pretty . sGuardedAlts instance SrcInfo loc => Pretty (A.GuardedAlt loc) where pretty = pretty . sGuardedAlt ------------------------- Statements in monads, guards & list comprehensions ----- instance SrcInfo loc => Pretty (A.Stmt loc) where pretty = pretty . sStmt instance SrcInfo loc => Pretty (A.QualStmt loc) where pretty = pretty . sQualStmt ------------------------- Record updates instance SrcInfo loc => Pretty (A.FieldUpdate loc) where pretty = pretty . sFieldUpdate ------------------------- Names ------------------------- instance Pretty (A.QOp l) where pretty = pretty . sQOp instance Pretty (A.QName l) where pretty = pretty . sQName instance Pretty (A.Op l) where pretty = pretty . sOp instance Pretty (A.Name l) where pretty = pretty . sName instance Pretty (A.IPName l) where pretty = pretty . sIPName instance SrcInfo loc => Pretty (A.IPBind loc) where pretty = pretty . sIPBind instance Pretty (A.CName l) where pretty = pretty . sCName instance Pretty (A.Context l) where pretty (A.CxEmpty _) = mySep [text "()", text "=>"] pretty (A.CxSingle _ asst) = mySep [pretty asst, text "=>"] pretty (A.CxTuple _ assts) = myFsep $ [parenList (map pretty assts), text "=>"] pretty (A.CxParen _ asst) = parens (pretty asst) -- hacked for multi-parameter type classes instance Pretty (A.Asst l) where pretty = pretty . sAsst ------------------------- pp utils ------------------------- maybePP :: (a -> Doc) -> Maybe a -> Doc maybePP pp Nothing = empty maybePP pp (Just a) = pp a parenList :: [Doc] -> Doc parenList = parens . myFsepSimple . punctuate comma hashParenList :: [Doc] -> Doc hashParenList = hashParens . myFsepSimple . punctuate comma where hashParens = parens . hashes hashes = \doc -> char '#' <> doc <> char '#' braceList :: [Doc] -> Doc braceList = braces . myFsepSimple . punctuate comma bracketList :: [Doc] -> Doc bracketList = brackets . myFsepSimple -- Wrap in braces and semicolons, with an extra space at the start in -- case the first doc begins with "-", which would be scanned as {- flatBlock :: [Doc] -> Doc flatBlock = braces . (space <>) . hsep . punctuate semi -- Same, but put each thing on a separate line prettyBlock :: [Doc] -> Doc prettyBlock = braces . (space <>) . vcat . punctuate semi -- Monadic PP Combinators -- these examine the env blankline :: Doc -> Doc blankline dl = do{e<-getPPEnv;if spacing e && layout e /= PPNoLayout then space $$ dl else dl} topLevel :: Doc -> [Doc] -> Doc topLevel header dl = do e <- fmap layout getPPEnv case e of PPOffsideRule -> header $$ vcat dl PPSemiColon -> header $$ prettyBlock dl PPInLine -> header $$ prettyBlock dl PPNoLayout -> header <+> flatBlock dl ppBody :: (PPHsMode -> Int) -> [Doc] -> Doc ppBody f dl = do e <- fmap layout getPPEnv case e of PPOffsideRule -> indent PPSemiColon -> indentExplicit _ -> flatBlock dl where indent = do{i <-fmap f getPPEnv;nest i . vcat $ dl} indentExplicit = do {i <- fmap f getPPEnv; nest i . prettyBlock $ dl} ($$$) :: Doc -> Doc -> Doc a $$$ b = layoutChoice (a $$) (a <+>) b mySep :: [Doc] -> Doc mySep = layoutChoice mySep' hsep where -- ensure paragraph fills with indentation. mySep' [x] = x mySep' (x:xs) = x <+> fsep xs mySep' [] = error "Internal error: mySep" myVcat :: [Doc] -> Doc myVcat = layoutChoice vcat hsep myFsepSimple :: [Doc] -> Doc myFsepSimple = layoutChoice fsep hsep -- same, except that continuation lines are indented, -- which is necessary to avoid triggering the offside rule. myFsep :: [Doc] -> Doc myFsep = layoutChoice fsep' hsep where fsep' [] = empty fsep' (d:ds) = do e <- getPPEnv let n = onsideIndent e nest n (fsep (nest (-n) d:ds)) layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc layoutChoice a b dl = do e <- getPPEnv if layout e == PPOffsideRule || layout e == PPSemiColon then a dl else b dl -- Prefix something with a LINE pragma, if requested. -- GHC's LINE pragma actually sets the current line number to n-1, so -- that the following line is line n. But if there's no newline before -- the line we're talking about, we need to compensate by adding 1. markLine :: SrcInfo s => s -> Doc -> Doc markLine loc doc = do e <- getPPEnv let y = startLine loc let line l = text ("{-# LINE " ++ show l ++ " \"" ++ fileName loc ++ "\" #-}") if linePragmas e then layoutChoice (line y $$) (line (y+1) <+>) doc else doc -------------------------------------------------------------------------------- -- Pretty-printing of internal constructs, for error messages while parsing instance SrcInfo loc => Pretty (P.PExp loc) where pretty (P.Lit _ l) = pretty l pretty (P.InfixApp _ a op b) = myFsep [pretty a, pretty op, pretty b] pretty (P.NegApp _ e) = myFsep [char '-', pretty e] pretty (P.App _ a b) = myFsep [pretty a, pretty b] pretty (P.Lambda _loc expList ppBody) = myFsep $ char '\\' : map pretty expList ++ [text "->", pretty ppBody] pretty (P.Let _ (A.BDecls _ declList) letBody) = ppLetExp declList letBody pretty (P.Let _ (A.IPBinds _ bindList) letBody) = ppLetExp bindList letBody pretty (P.If _ cond thenexp elsexp) = myFsep [text "if", pretty cond, text "then", pretty thenexp, text "else", pretty elsexp] pretty (P.Case _ cond altList) = myFsep [text "case", pretty cond, text "of"] $$$ ppBody caseIndent (map pretty altList) pretty (P.Do _ stmtList) = text "do" $$$ ppBody doIndent (map pretty stmtList) pretty (P.MDo _ stmtList) = text "mdo" $$$ ppBody doIndent (map pretty stmtList) pretty (P.Var _ name) = pretty name pretty (P.IPVar _ ipname) = pretty ipname pretty (P.Con _ name) = pretty name pretty (P.TupleSection _ bxd mExpList) = let ds = map (maybePP pretty) mExpList in case bxd of Boxed -> parenList ds Unboxed -> hashParenList ds pretty (P.Paren _ e) = parens . pretty $ e pretty (P.RecConstr _ c fieldList) = pretty c <> (braceList . map pretty $ fieldList) pretty (P.RecUpdate _ e fieldList) = pretty e <> (braceList . map pretty $ fieldList) pretty (P.List _ list) = bracketList . punctuate comma . map pretty $ list pretty (P.EnumFrom _ e) = bracketList [pretty e, text ".."] pretty (P.EnumFromTo _ from to) = bracketList [pretty from, text "..", pretty to] pretty (P.EnumFromThen _ from thenE) = bracketList [pretty from <> comma, pretty thenE, text ".."] pretty (P.EnumFromThenTo _ from thenE to) = bracketList [pretty from <> comma, pretty thenE, text "..", pretty to] pretty (P.ParComp _ e qualLists) = bracketList (intersperse (char '|') $ pretty e : (punctuate comma . concatMap (map pretty) $ qualLists)) pretty (P.ExpTypeSig _pos e ty) = myFsep [pretty e, text "::", pretty ty] pretty (P.BracketExp _ b) = pretty b pretty (P.SpliceExp _ s) = pretty s pretty (P.TypQuote _ t) = text "\'\'" <> pretty t pretty (P.VarQuote _ x) = text "\'" <> pretty x pretty (P.QuasiQuote _ n qt) = text ("[$" ++ n ++ "|" ++ qt ++ "|]") pretty (P.XTag _ n attrs mattr cs) = let ax = maybe [] (return . pretty) mattr in hcat $ (myFsep $ (char '<' <> pretty n): map pretty attrs ++ ax ++ [char '>']): map pretty cs ++ [myFsep $ [text " pretty n, char '>']] pretty (P.XETag _ n attrs mattr) = let ax = maybe [] (return . pretty) mattr in myFsep $ (char '<' <> pretty n): map pretty attrs ++ ax ++ [text "/>"] pretty (P.XPcdata _ s) = text s pretty (P.XExpTag _ e) = myFsep $ [text "<%", pretty e, text "%>"] pretty (P.XChildTag _ es) = myFsep $ text "<%>" : map pretty es ++ [text ""] pretty (P.CorePragma _ s e) = myFsep $ map text ["{-# CORE", show s, "#-}"] ++ [pretty e] pretty (P.SCCPragma _ s e) = myFsep $ map text ["{-# SCC", show s, "#-}"] ++ [pretty e] pretty (P.GenPragma _ s (a,b) (c,d) e) = myFsep $ [text "{-# GENERATED", text $ show s, int a, char ':', int b, char '-', int c, char ':', int d, text "#-}", pretty e] pretty (P.Proc _ p e) = myFsep $ [text "proc", pretty p, text "->", pretty e] pretty (P.LeftArrApp _ l r) = myFsep $ [pretty l, text "-<", pretty r] pretty (P.RightArrApp _ l r) = myFsep $ [pretty l, text ">-", pretty r] pretty (P.LeftArrHighApp _ l r) = myFsep $ [pretty l, text "-<<", pretty r] pretty (P.RightArrHighApp _ l r) = myFsep $ [pretty l, text ">>-", pretty r] pretty (P.AsPat _ name (P.IrrPat _ pat)) = myFsep [pretty name <> char '@', char '~' <> pretty pat] pretty (P.AsPat _ name pat) = hcat [pretty name, char '@', pretty pat] pretty (P.WildCard _) = char '_' pretty (P.IrrPat _ pat) = char '~' <> pretty pat pretty (P.PostOp _ e op) = pretty e <+> pretty op pretty (P.PreOp _ op e) = pretty op <+> pretty e pretty (P.ViewPat _ e p) = myFsep [pretty e, text "->", pretty p] pretty (P.SeqRP _ rs) = myFsep $ text "(/" : map pretty rs ++ [text "/)"] pretty (P.GuardRP _ r gs) = myFsep $ text "(|" : pretty r : char '|' : map pretty gs ++ [text "|)"] pretty (P.EitherRP _ r1 r2) = parens . myFsep $ [pretty r1, char '|', pretty r2] pretty (P.CAsRP _ n (P.IrrPat _ e)) = myFsep [pretty n <> text "@:", char '~' <> pretty e] pretty (P.CAsRP _ n r) = hcat [pretty n, text "@:", pretty r] pretty (P.XRPats _ ps) = myFsep $ text "<[" : map pretty ps ++ [text "%>"] pretty (P.ExplTypeArg _ qn t) = myFsep [pretty qn, text "{|", pretty t, text "|}"] pretty (P.BangPat _ e) = text "!" <> pretty e instance SrcInfo loc => Pretty (P.PFieldUpdate loc) where pretty (P.FieldUpdate _ name e) = myFsep [pretty name, equals, pretty e] pretty (P.FieldPun _ name) = pretty name pretty (P.FieldWildcard _) = text ".." instance SrcInfo loc => Pretty (P.ParseXAttr loc) where pretty (P.XAttr _ n v) = myFsep [pretty n, char '=', pretty v] instance SrcInfo loc => Pretty (P.PContext loc) where pretty (P.CxEmpty _) = mySep [text "()", text "=>"] pretty (P.CxSingle _ asst) = mySep [pretty asst, text "=>"] pretty (P.CxTuple _ assts) = myFsep $ [parenList (map pretty assts), text "=>"] pretty (P.CxParen _ asst) = parens (pretty asst) instance SrcInfo loc => Pretty (P.PAsst loc) where pretty (P.ClassA _ a ts) = myFsep $ ppQName (sQName a) : map (prettyPrec prec_atype) ts pretty (P.InfixA _ a op b) = myFsep $ [pretty a, ppQNameInfix (sQName op), pretty b] pretty (P.IParam _ i t) = myFsep $ [pretty i, text "::", pretty t] pretty (P.EqualP _ t1 t2) = myFsep $ [pretty t1, text "~", pretty t2] instance SrcInfo loc => Pretty (P.PType loc) where prettyPrec p (P.TyForall _ mtvs ctxt htype) = parensIf (p > 0) $ myFsep [ppForall (fmap (map sTyVarBind) mtvs), maybePP pretty ctxt, pretty htype] prettyPrec p (P.TyFun _ a b) = parensIf (p > 0) $ myFsep [prettyPrec prec_btype a, text "->", pretty b] prettyPrec _ (P.TyTuple _ bxd l) = let ds = map pretty l in case bxd of Boxed -> parenList ds Unboxed -> hashParenList ds prettyPrec _ (P.TyList _ t) = brackets $ pretty t prettyPrec p (P.TyApp _ a b) = {- | a == list_tycon = brackets $ pretty b -- special case | otherwise = -} parensIf (p > prec_btype) $ myFsep [pretty a, prettyPrec prec_atype b] prettyPrec _ (P.TyVar _ name) = pretty name prettyPrec _ (P.TyCon _ name) = pretty name prettyPrec _ (P.TyParen _ t) = parens (pretty t) prettyPrec _ (P.TyPred _ asst) = pretty asst prettyPrec _ (P.TyInfix _ a op b) = myFsep [pretty a, ppQNameInfix (sQName op), pretty b] prettyPrec _ (P.TyKind _ t k) = parens (myFsep [pretty t, text "::", pretty k]) haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Annotated.hs0000644000000000000000000001464312204617765022267 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts -- Copyright : (c) Niklas Broberg 2004-2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- An umbrella module for the various functionality -- of the package. Also provides some convenient -- functionality for dealing directly with source files. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Annotated ( -- * Re-exported modules module Language.Haskell.Exts.Annotated.Syntax , module Language.Haskell.Exts.Annotated.Build , module Language.Haskell.Exts.Parser , module Language.Haskell.Exts.Lexer , module Language.Haskell.Exts.Pretty , module Language.Haskell.Exts.Annotated.Fixity , module Language.Haskell.Exts.Annotated.ExactPrint , module Language.Haskell.Exts.SrcLoc , module Language.Haskell.Exts.Comments , module Language.Haskell.Exts.Extension -- * Parsing of Haskell source files , parseFile , parseFileWithMode , parseFileWithExts , parseFileWithComments , parseFileContents , parseFileContentsWithMode , parseFileContentsWithExts , parseFileContentsWithComments -- * Parsing of Haskell source elements, , parseModule, parseModuleWithMode, parseModuleWithComments , parseExp, parseExpWithMode, parseExpWithComments , parseStmt, parseStmtWithMode, parseStmtWithComments , parsePat, parsePatWithMode, parsePatWithComments , parseDecl, parseDeclWithMode, parseDeclWithComments , parseType, parseTypeWithMode, parseTypeWithComments -- * Read extensions declared in LANGUAGE pragmas , readExtensions ) where import Language.Haskell.Exts.Annotated.Build import Language.Haskell.Exts.Annotated.Syntax import Language.Haskell.Exts.Parser ( Parseable(..), ParseResult(..), fromParseResult, ParseMode(..), defaultParseMode ) import Language.Haskell.Exts.Lexer ( lexTokenStream, lexTokenStreamWithMode, Token(..) ) import Language.Haskell.Exts.Pretty import Language.Haskell.Exts.Annotated.Fixity import Language.Haskell.Exts.Annotated.ExactPrint import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.Extension import Language.Haskell.Exts.Comments import Language.Haskell.Exts.InternalParser import Data.List import Language.Preprocessor.Unlit -- | Parse a source file on disk, using the default parse mode. parseFile :: FilePath -> IO (ParseResult (Module SrcSpanInfo)) parseFile fp = parseFileWithMode (defaultParseMode { parseFilename = fp }) fp -- | Parse a source file on disk, with an extra set of extensions to know about -- on top of what the file itself declares. parseFileWithExts :: [Extension] -> FilePath -> IO (ParseResult (Module SrcSpanInfo)) parseFileWithExts exts fp = parseFileWithMode (defaultParseMode { extensions = exts, parseFilename = fp }) fp -- | Parse a source file on disk, supplying a custom parse mode. parseFileWithMode :: ParseMode -> FilePath -> IO (ParseResult (Module SrcSpanInfo)) parseFileWithMode p fp = readFile fp >>= (return . parseFileContentsWithMode p) parseFileWithComments :: ParseMode -> FilePath -> IO (ParseResult (Module SrcSpanInfo, [Comment])) parseFileWithComments p fp = readFile fp >>= (return . parseFileContentsWithComments p) -- | Parse a source file from a string using the default parse mode. parseFileContents :: String -> ParseResult (Module SrcSpanInfo) parseFileContents = parseFileContentsWithMode defaultParseMode -- | Parse a source file from a string, with an extra set of extensions to know about -- on top of what the file itself declares. parseFileContentsWithExts :: [Extension] -> String -> ParseResult (Module SrcSpanInfo) parseFileContentsWithExts exts = parseFileContentsWithMode (defaultParseMode { extensions = exts }) -- | Parse a source file from a string using a custom parse mode. parseFileContentsWithMode :: ParseMode -> String -> ParseResult (Module SrcSpanInfo) parseFileContentsWithMode p@(ParseMode fn oldLang exts ign _ _) rawStr = let md = delit fn $ ppContents rawStr (bLang, extraExts) = case (ign, readExtensions md) of (False, Just (mLang, es)) -> (case mLang of {Nothing -> oldLang;Just newLang -> newLang}, es) _ -> (oldLang, []) in -- trace (fn ++ ": " ++ show extraExts) $ parseModuleWithMode (p { baseLanguage = bLang, extensions = exts ++ extraExts }) md parseFileContentsWithComments :: ParseMode -> String -> ParseResult (Module SrcSpanInfo, [Comment]) parseFileContentsWithComments p@(ParseMode fn oldLang exts ign _ _) rawStr = let md = delit fn $ ppContents rawStr (bLang, extraExts) = case (ign, readExtensions md) of (False, Just (mLang, es)) -> (case mLang of {Nothing -> oldLang;Just newLang -> newLang}, es) _ -> (oldLang, []) in parseModuleWithComments (p { baseLanguage = bLang, extensions = exts ++ extraExts }) md -- | Gather the extensions declared in LANGUAGE pragmas -- at the top of the file. Returns 'Nothing' if the -- parse of the pragmas fails. readExtensions :: String -> Maybe (Maybe Language, [Extension]) readExtensions str = case getTopPragmas str of ParseOk pgms -> extractLang $ concatMap getExts pgms _ -> Nothing where getExts :: ModulePragma l -> [Either Language Extension] getExts (LanguagePragma _ ns) = map readExt ns getExts _ = [] readExt (Ident _ e) = case classifyLanguage e of UnknownLanguage _ -> Right $ classifyExtension e lang -> Left lang extractLang = extractLang' Nothing [] extractLang' lacc eacc [] = Just (lacc, eacc) extractLang' Nothing eacc (Left l : rest) = extractLang' (Just l) eacc rest extractLang' (Just l1) eacc (Left l2:rest) | l1 == l2 = extractLang' (Just l1) eacc rest | otherwise = Nothing extractLang' lacc eacc (Right ext : rest) = extractLang' lacc (ext:eacc) rest ppContents :: String -> String ppContents = unlines . f . lines where f (('#':_):rest) = rest f x = x delit :: String -> String -> String delit fn = if ".lhs" `isSuffixOf` fn then unlit fn else id haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Extension.hs0000644000000000000000000005553212204617765022330 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Extension -- Copyright : (c) Niklas Broberg 2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, niklas.broberg@chalmers.se -- Stability : transient -- Portability : portable -- -- This module defines the list of recognized modular features -- of Haskell, most often (sloppily) referred to as "extensions". -- -- Closely mimicking the Language.Haskell.Extension module from -- the Cabal library, this package also includes functionality for -- "computing" languages as sets of features. Also, we make no -- promise not to add extensions not yet recognized by Cabal. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Extension ( -- * Language definitions Language(..), knownLanguages, classifyLanguage, prettyLanguage, -- * Extensions Extension(..), KnownExtension(..), classifyExtension, parseExtension, prettyExtension, -- * Extension groups ghcDefault, glasgowExts, knownExtensions, deprecatedExtensions, -- * Semantics of extensions applied to languages impliesExts, toExtensionList ) where import Control.Applicative ((<$>), (<|>)) import Data.Array (Array, accumArray, bounds, Ix(inRange), (!)) import Data.List (nub, (\\), delete) import Data.Maybe (fromMaybe) -- Copyright notice from Cabal's Language.Haskell.Extension, -- from which we borrow plenty of features: {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} data Language = -- | The Haskell 98 language as defined by the Haskell 98 report. -- Haskell98 -- | The Haskell 2010 language as defined by the Haskell 2010 report. -- | Haskell2010 -- | The minimal language resulting from disabling all recognized -- extensions - including ones that are part of all known language -- definitions e.g. MonomorphismRestriction. | HaskellAllDisabled -- | An unknown language, identified by its name. | UnknownLanguage String deriving (Show, Read, Eq, Ord) knownLanguages :: [Language] knownLanguages = [Haskell98, Haskell2010] classifyLanguage :: String -> Language classifyLanguage = \str -> case lookup str langTable of Just lang -> lang Nothing -> UnknownLanguage str where langTable = [ (show lang, lang) | lang <- knownLanguages ] prettyLanguage :: Language -> String prettyLanguage (UnknownLanguage name) = name prettyLanguage lang = show lang -- | This represents language extensions beyond a base 'Language' definition -- (such as 'Haskell98') that are supported by some implementations, usually -- in some special mode. data Extension = -- | Enable a known extension EnableExtension KnownExtension -- | Disable a known extension | DisableExtension KnownExtension -- | An unknown extension, identified by the name of its @LANGUAGE@ -- pragma. | UnknownExtension String deriving (Show, Read, Eq, Ord) data KnownExtension = -- | [GHC § 7.6.3.4] Allow overlapping class instances, -- provided there is a unique most specific instance for each use. OverlappingInstances -- | [GHC § 7.6.3.3] Ignore structural rules guaranteeing the -- termination of class instance resolution. Termination is -- guaranteed by a fixed-depth recursion stack, and compilation -- may fail if this depth is exceeded. | UndecidableInstances -- | [GHC § 7.6.3.4] Implies 'OverlappingInstances'. Allow the -- implementation to choose an instance even when it is possible -- that further instantiation of types will lead to a more specific -- instance being applicable. | IncoherentInstances {- DoRec not yet supported by HSE. -- | [GHC § 7.3.8] Allows recursive bindings in @do@ blocks, -- using the @rec@ keyword. | DoRec -} -- | [GHC § 7.3.8.2] Deprecated in GHC. Allows recursive bindings -- using @mdo@, a variant of @do@. @DoRec@ provides a different, -- preferred syntax. | RecursiveDo -- | [GHC § 7.3.9] Provide syntax for writing list -- comprehensions which iterate over several lists together, like -- the 'zipWith' family of functions. | ParallelListComp -- | [GHC § 7.6.1.1] Allow multiple parameters in a type class. | MultiParamTypeClasses -- | [GHC § 7.17] Enable the dreaded monomorphism restriction. | MonomorphismRestriction -- | [GHC § 7.6.2] Allow a specification attached to a -- multi-parameter type class which indicates that some parameters -- are entirely determined by others. The implementation will check -- that this property holds for the declared instances, and will use -- this property to reduce ambiguity in instance resolution. | FunctionalDependencies -- | [GHC § 7.8.5] Like 'RankNTypes' but does not allow a -- higher-rank type to itself appear on the left of a function -- arrow. | Rank2Types -- | [GHC § 7.8.5] Allow a universally-quantified type to occur on -- the left of a function arrow. | RankNTypes -- | [GHC § 7.8.5] Allow data constructors to have polymorphic -- arguments. Unlike 'RankNTypes', does not allow this for ordinary -- functions. | PolymorphicComponents -- | [GHC § 7.4.4] Allow existentially-quantified data constructors. | ExistentialQuantification -- | [GHC § 7.8.7] Cause a type variable in a signature, which has an -- explicit @forall@ quantifier, to scope over the definition of the -- accompanying value declaration. | ScopedTypeVariables -- | Deprecated, use 'ScopedTypeVariables' instead. | PatternSignatures -- | [GHC § 7.8.3] Enable implicit function parameters with dynamic -- scope. | ImplicitParams -- | [GHC § 7.8.2] Relax some restrictions on the form of the context -- of a type signature. | FlexibleContexts -- | [GHC § 7.6.3.2] Relax some restrictions on the form of the -- context of an instance declaration. | FlexibleInstances -- | [GHC § 7.4.1] Allow data type declarations with no constructors. | EmptyDataDecls -- | [GHC § 4.10.3] Run the C preprocessor on Haskell source code. | CPP -- | [GHC § 7.8.4] Allow an explicit kind signature giving the kind of -- types over which a type variable ranges. | KindSignatures -- | [GHC § 7.11] Enable a form of pattern which forces evaluation -- before an attempted match, and a form of strict @let@/@where@ -- binding. | BangPatterns -- | [GHC § 7.6.3.1] Allow type synonyms in instance heads. | TypeSynonymInstances -- | [GHC § 7.9] Enable Template Haskell, a system for compile-time -- metaprogramming. | TemplateHaskell -- | [GHC § 8] Enable the Foreign Function Interface. In GHC, -- implements the standard Haskell 98 Foreign Function Interface -- Addendum, plus some GHC-specific extensions. | ForeignFunctionInterface -- | [GHC § 7.10] Enable arrow notation. | Arrows -- | [GHC § 7.16] Enable generic type classes, with default instances -- defined in terms of the algebraic structure of a type. | Generics -- | [GHC § 7.3.11] Enable the implicit importing of the module -- @Prelude@. When disabled, when desugaring certain built-in syntax -- into ordinary identifiers, use whatever is in scope rather than the -- @Prelude@ -- version. | ImplicitPrelude -- | [GHC § 7.3.15] Enable syntax for implicitly binding local names -- corresponding to the field names of a record. Puns bind specific -- names, unlike 'RecordWildCards'. | NamedFieldPuns -- | [GHC § 7.3.5] Enable a form of guard which matches a pattern and -- binds variables. | PatternGuards -- | [GHC § 7.5.4] Allow a type declared with @newtype@ to use -- @deriving@ for any class with an instance for the underlying type. | GeneralizedNewtypeDeriving -- | [Hugs § 7.1] Enable the \"Trex\" extensible records system. | ExtensibleRecords -- | [Hugs § 7.2] Enable type synonyms which are transparent in -- some definitions and opaque elsewhere, as a way of implementing -- abstract datatypes. | RestrictedTypeSynonyms -- | [Hugs § 7.3] Enable an alternate syntax for string literals, -- with string templating. | HereDocuments -- | [GHC § 7.3.2] Allow the character @#@ as a postfix modifier on -- identifiers. Also enables literal syntax for unboxed values. | MagicHash -- | [GHC § 7.7] Allow data types and type synonyms which are -- indexed by types, i.e. ad-hoc polymorphism for types. | TypeFamilies -- | [GHC § 7.5.2] Allow a standalone declaration which invokes the -- type class @deriving@ mechanism. | StandaloneDeriving -- | [GHC § 7.3.1] Allow certain Unicode characters to stand for -- certain ASCII character sequences, e.g. keywords and punctuation. | UnicodeSyntax -- | [GHC § 8.1.1] Allow the use of unboxed types as foreign types, -- e.g. in @foreign import@ and @foreign export@. | UnliftedFFITypes -- | [GHC § 7.4.3] Defer validity checking of types until after -- expanding type synonyms, relaxing the constraints on how synonyms -- may be used. | LiberalTypeSynonyms -- | [GHC § 7.4.2] Allow the name of a type constructor, type class, -- or type variable to be an infix operator. | TypeOperators --PArr -- not ready yet, and will probably be renamed to ParallelArrays -- | [GHC § 7.3.16] Enable syntax for implicitly binding local names -- corresponding to the field names of a record. A wildcard binds -- all unmentioned names, unlike 'NamedFieldPuns'. | RecordWildCards -- | Deprecated, use 'NamedFieldPuns' instead. | RecordPuns -- | [GHC § 7.3.14] Allow a record field name to be disambiguated -- by the type of the record it's in. | DisambiguateRecordFields -- | [GHC § 7.6.4] Enable overloading of string literals using a -- type class, much like integer literals. | OverloadedStrings -- | [GHC § 7.4.6] Enable generalized algebraic data types, in -- which type variables may be instantiated on a per-constructor -- basis. Implies GADTSyntax. | GADTs {- GADTSyntax (the extension name) not yet supported by HSE -- | Enable GADT syntax for declaring ordinary algebraic datatypes. | GADTSyntax -} -- | [GHC § 7.17.2] Make pattern bindings monomorphic. | MonoPatBinds -- | [GHC § 7.8.8] Relax the requirements on mutually-recursive -- polymorphic functions. | RelaxedPolyRec -- | [GHC § 2.4.5] Allow default instantiation of polymorphic -- types in more situations. | ExtendedDefaultRules -- | [GHC § 7.2.2] Enable unboxed tuples. | UnboxedTuples -- | [GHC § 7.5.3] Enable @deriving@ for classes -- @Data.Typeable.Typeable@ and @Data.Generics.Data@. | DeriveDataTypeable -- | [GHC § 7.6.1.3] Allow a class method's type to place -- additional constraints on a class type variable. | ConstrainedClassMethods -- | [GHC § 7.3.18] Allow imports to be qualified by the package -- name the module is intended to be imported from, e.g. -- -- > import "network" Network.Socket | PackageImports -- | [GHC § 7.8.6] Deprecated in GHC 6.12 and will be removed in -- GHC 7. Allow a type variable to be instantiated at a -- polymorphic type. | ImpredicativeTypes -- | [GHC § 7.3.3] Change the syntax for qualified infix -- operators. | NewQualifiedOperators -- | [GHC § 7.3.12] Relax the interpretation of left operator -- sections to allow unary postfix operators. | PostfixOperators -- | [GHC § 7.9.5] Enable quasi-quotation, a mechanism for defining -- new concrete syntax for expressions and patterns. | QuasiQuotes -- | [GHC § 7.3.10] Enable generalized list comprehensions, -- supporting operations such as sorting and grouping. | TransformListComp -- | [GHC § 7.3.6] Enable view patterns, which match a value by -- applying a function and matching on the result. | ViewPatterns -- | Allow concrete XML syntax to be used in expressions and patterns, -- as per the Haskell Server Pages extension language: -- . The ideas behind it are -- discussed in the paper \"Haskell Server Pages through Dynamic Loading\" -- by Niklas Broberg, from Haskell Workshop '05. | XmlSyntax -- | Allow regular pattern matching over lists, as discussed in the -- paper \"Regular Expression Patterns\" by Niklas Broberg, Andreas Farre -- and Josef Svenningsson, from ICFP '04. | RegularPatterns -- | Enables the use of tuple sections, e.g. @(, True)@ desugars into -- @\x -> (x, True)@. | TupleSections -- | Allows GHC primops, written in C--, to be imported into a Haskell -- file. | GHCForeignImportPrim -- | Support for patterns of the form @n + k@, where @k@ is an -- integer literal. | NPlusKPatterns -- | Improve the layout rule when @if@ expressions are used in a @do@ -- block. | DoAndIfThenElse -- | Makes much of the Haskell sugar be desugared into calls to the -- function with a particular name that is in scope. | RebindableSyntax -- | Make @forall@ a keyword in types, which can be used to give the -- generalisation explicitly. | ExplicitForAll -- | Allow contexts to be put on datatypes, e.g. the @Eq a@ in -- @data Eq a => Set a = NilSet | ConsSet a (Set a)@. | DatatypeContexts -- | Local (@let@ and @where@) bindings are monomorphic. | MonoLocalBinds -- | Enable @deriving@ for the @Data.Functor.Functor@ class. | DeriveFunctor -- | Enable @deriving@ for the @Data.Traversable.Traversable@ class. | DeriveTraversable -- | Enable @deriving@ for the @Data.Foldable.Foldable@ class. | DeriveFoldable -- | Enable non-decreasing indentation for 'do' blocks. | NondecreasingIndentation -- | [GHC § 8.1.4] Enable interruptible FFI. | InterruptibleFFI -- | [GHC § 8.1.5] Enable the 'capi' calling convention in the -- foreign function interface. | CApiFFI {- Safe Haskell not yet supported by HSE. -- | [GHC § 7.20.3] Allow imports to be qualified with a safe -- keyword that requires the imported module be trusted as according -- to the Safe Haskell definition of trust. -- -- > import safe Network.Socket | SafeImports -- | [GHC § 7.20] Compile a module in the Safe, Safe Haskell -- mode -- a restricted form of the Haskell language to ensure -- type safety. | Safe -- | [GHC § 7.20] Compile a module in the Trustworthy, Safe -- Haskell mode -- no restrictions apply but the module is marked -- as trusted as long as the package the module resides in is -- trusted. | Trustworthy -} {- ConstraintKinds not yet supported by HSE -- | [GHC § 7.40] Allow type class/implicit parameter/equality -- constraints to be used as types with the special kind Constraint. -- Also generalise the (ctxt => ty) syntax so that any type of kind -- Constraint can occur before the arrow. | ConstraintKinds -} deriving (Show, Read, Eq, Ord, Enum, Bounded) -- | Certain extensions imply other extensions, and this function -- makes the implication explicit. This also handles deprecated -- extensions, which imply their replacements. -- The returned value is the transitive closure of implied -- extensions. {-impliesExts :: [Extension] -> [Extension] impliesExts exts = let posExts = [ ke | EnableExtension ke <- exts ] negExts = [ ke | DisableExtension ke <- exts ] implExts = impliesKnownExts posExts in -} impliesExts :: [KnownExtension] -> [KnownExtension] impliesExts = go where go [] = [] go es = let xs = concatMap implE es ys = filter (not . flip elem es) xs in es ++ go ys implE e = case e of TypeFamilies -> [KindSignatures] ScopedTypeVariables -> [TypeOperators, ExplicitForAll] XmlSyntax -> [RegularPatterns] RegularPatterns -> [PatternGuards] RankNTypes -> [Rank2Types, ExplicitForAll] Rank2Types -> [PolymorphicComponents, ExplicitForAll] PolymorphicComponents -> [ExplicitForAll] LiberalTypeSynonyms -> [ExplicitForAll] ExistentialQuantification -> [ExplicitForAll] -- Deprecations RecordPuns -> [NamedFieldPuns] PatternSignatures -> [ScopedTypeVariables] e -> [] -- | The list of extensions enabled by -- GHC's portmanteau -fglasgow-exts flag. glasgowExts :: [Extension] glasgowExts = map EnableExtension [ ForeignFunctionInterface , UnliftedFFITypes , GADTs , ImplicitParams , ScopedTypeVariables , UnboxedTuples , TypeSynonymInstances , StandaloneDeriving , DeriveDataTypeable , FlexibleContexts , FlexibleInstances , ConstrainedClassMethods , MultiParamTypeClasses , FunctionalDependencies , MagicHash , PolymorphicComponents , ExistentialQuantification , UnicodeSyntax , PostfixOperators , PatternGuards , LiberalTypeSynonyms , RankNTypes , ImpredicativeTypes , TypeOperators , RecursiveDo , ParallelListComp , EmptyDataDecls , KindSignatures , GeneralizedNewtypeDeriving , TypeFamilies ] -- Not exported, just used locally in several places. allLangDefault :: [KnownExtension] allLangDefault = [MonomorphismRestriction, MonoPatBinds, ImplicitPrelude] ghcDefault :: [Extension] ghcDefault = map EnableExtension (NondecreasingIndentation:allLangDefault) -- | List of all known extensions, all enabled. knownExtensions :: [Extension] knownExtensions = concat [ [EnableExtension x, DisableExtension x] | x <- [minBound..maxBound] ] -- | Extensions that have been deprecated, possibly paired with another -- extension that replaces it. -- deprecatedExtensions :: [(Extension, Maybe Extension)] deprecatedExtensions = [ (EnableExtension RecordPuns, Just (EnableExtension NamedFieldPuns)) , (EnableExtension PatternSignatures, Just (EnableExtension ScopedTypeVariables)) ] -- | A clever version of read that returns an 'UnknownExtension' -- if the string is not recognised. classifyExtension :: String -> Extension classifyExtension string = case classifyKnownExtension string of Just ext -> EnableExtension ext Nothing -> case string of 'N':'o':string' -> case classifyKnownExtension string' of Just ext -> DisableExtension ext Nothing -> UnknownExtension string _ -> UnknownExtension string classifyKnownExtension :: String -> Maybe KnownExtension classifyKnownExtension "" = Nothing classifyKnownExtension string@(c : _) | inRange (bounds knownExtensionTable) c = lookup string (knownExtensionTable ! c) | otherwise = Nothing knownExtensionTable :: Array Char [(String, KnownExtension)] knownExtensionTable = accumArray (flip (:)) [] ('A', 'Z') [ (head str, (str, extension)) | extension <- [toEnum 0 ..] , let str = show extension ] -- | Parse an enabled or disabled extension; returns -- 'UnknownExtension' if the parse fails. parseExtension :: String -> Extension parseExtension str = fromMaybe (UnknownExtension str) $ EnableExtension <$> readMay str <|> DisableExtension <$> (readMay =<< dropNo str) where dropNo ('N':'o':rest) = Just rest dropNo _ = Nothing -- | Pretty print an extension. Disabled extensions are prefixed with -- \'No\'. prettyExtension :: Extension -> String prettyExtension (EnableExtension ext) = show ext prettyExtension (DisableExtension ext) = "No" ++ show ext prettyExtension (UnknownExtension str) = str readMay :: Read a => String -> Maybe a readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of [x] -> Just x _ -> Nothing {------------------------------------------- -- Transform a 'Language', and possibly a modifying set of'Extension's, into a list -- of 'KnownExtension's, to be interpreted as modifying the language you get -- when all known extensions are disabled. -- Extensions are interpreted in a right-biased fashion, so the last instance -- of an occurence of 'EnableExtension' or 'DisableExtension' for a given -- 'KnownExtension' takes precedence. -------------------------------------------} toExtensionList :: Language -> [Extension] -> [KnownExtension] toExtensionList lang exts = let langKes = case lang of Haskell98 -> NPlusKPatterns:allLangDefault Haskell2010 -> [DoAndIfThenElse , PatternGuards , ForeignFunctionInterface , EmptyDataDecls ] ++ allLangDefault HaskellAllDisabled -> [] UnknownLanguage s -> error $ "toExtensionList: Unknown language " ++ s {- addExts = [ ke | EnableExtension ke <- exts ] remExts = [ ke | DisableExtension ke <- exts ] in impliesExts $ nub $ (langKes ++ addExts) \\ remExts -} in impliesExts $ go langKes exts where go :: [KnownExtension] -> [Extension] -> [KnownExtension] go acc [] = acc go acc (DisableExtension x : exts) = go (nub (delete x acc)) exts go acc (EnableExtension x : exts) = go (nub (x : acc)) exts -- We just throw away UnknownExtensions go acc (_ : exts) = go acc exts haskell-src-exts-1.14.0/src/Language/Haskell/Exts/ParseMonad.hs0000644000000000000000000003662412204617765022406 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Annotated.ParseMonad -- Copyright : Niklas Broberg (c) 2004-2009, -- Original (c) The GHC Team, 1997-2000 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- Monads for the Haskell parser and lexer. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.ParseMonad( -- * Parsing P, ParseResult(..), atSrcLoc, LexContext(..), ParseMode(..), defaultParseMode, fromParseResult, runParserWithMode, runParserWithModeComments, runParser, getSrcLoc, pushCurrentContext, popContext, getExtensions, -- * Lexing Lex(runL), getInput, discard, lexNewline, lexTab, lexWhile, alternative, checkBOL, setBOL, startToken, getOffside, pushContextL, popContextL, getExtensionsL, pushComment, getSrcLocL, setSrcLineL, ignoreLinePragmasL, setLineFilenameL, -- * Harp/Hsx ExtContext(..), pushExtContextL, popExtContextL, getExtContext, pullCtxtFlag, flagDo, getModuleName ) where import Language.Haskell.Exts.SrcLoc(SrcLoc(..)) import Language.Haskell.Exts.Fixity (Fixity, preludeFixities) import Language.Haskell.Exts.Comments import Language.Haskell.Exts.Extension -- (Extension, impliesExts, haskell2010) import Data.List ( intersperse ) import Control.Applicative import Control.Monad (when) import Data.Monoid -- | The result of a parse. data ParseResult a = ParseOk a -- ^ The parse succeeded, yielding a value. | ParseFailed SrcLoc String -- ^ The parse failed at the specified -- source location, with an error message. deriving Show -- | Retrieve the result of a successful parse, throwing an -- error if the parse is actually not successful. fromParseResult :: ParseResult a -> a fromParseResult (ParseOk a) = a fromParseResult (ParseFailed loc str) = error $ "fromParseResult: Parse failed at [" ++ srcFilename loc ++ "] (" ++ show (srcLine loc) ++ ":" ++ show (srcColumn loc) ++ "): " ++ str instance Functor ParseResult where fmap f (ParseOk x) = ParseOk $ f x fmap f (ParseFailed loc msg) = ParseFailed loc msg instance Applicative ParseResult where pure = ParseOk ParseOk f <*> x = f <$> x ParseFailed loc msg <*> _ = ParseFailed loc msg instance Monad ParseResult where return = ParseOk ParseOk x >>= f = f x ParseFailed loc msg >>= _ = ParseFailed loc msg instance Monoid m => Monoid (ParseResult m) where mempty = ParseOk mempty ParseOk x `mappend` ParseOk y = ParseOk $ x `mappend` y ParseOk x `mappend` err = err err `mappend` _ = err -- left-biased -- internal version data ParseStatus a = Ok ParseState a | Failed SrcLoc String deriving Show data LexContext = NoLayout | Layout Int deriving (Eq,Ord,Show) data ExtContext = CodeCtxt | HarpCtxt | TagCtxt | ChildCtxt | CloseTagCtxt | CodeTagCtxt deriving (Eq,Ord,Show) type CtxtFlag = (Bool,Bool) -- (True,_) = We're in a do context. -- (_, True)= Next token must be a virtual closing brace. type ParseState = ([LexContext],[ExtContext],CtxtFlag,[Comment]) indentOfParseState :: ParseState -> Int indentOfParseState (Layout n:_,_,_,_) = n indentOfParseState _ = 0 -- | Static parameters governing a parse. -- Note that the various parse functions in "Language.Haskell.Exts.Parser" -- never look at LANGUAGE pragmas, regardless of -- what the @ignoreLanguagePragmas@ flag is set to. -- Only the various @parseFile@ functions in "Language.Haskell.Exts" will -- act on it, when set to 'False'. data ParseMode = ParseMode { -- | original name of the file being parsed parseFilename :: String, -- | base language (e.g. Haskell98, Haskell2010) baseLanguage :: Language, -- | list of extensions enabled for parsing extensions :: [Extension], -- | if 'True', the parser won't care about further extensions -- in LANGUAGE pragmas in source files ignoreLanguagePragmas :: Bool, -- | if 'True', the parser won't read line position information -- from LINE pragmas in source files ignoreLinePragmas :: Bool, -- | list of fixities to be aware of fixities :: Maybe [Fixity] } -- | Default parameters for a parse. -- The default is an unknown filename, -- no extensions (i.e. Haskell 98), -- don't ignore LANGUAGE pragmas, do ignore LINE pragmas, -- and be aware of fixities from the 'Prelude'. defaultParseMode :: ParseMode defaultParseMode = ParseMode { parseFilename = ".hs", baseLanguage = Haskell2010, extensions = [], ignoreLanguagePragmas = False, ignoreLinePragmas = True, fixities = Just preludeFixities } -- Version of ParseMode used internally, -- where the language and extensions have -- been expanded data InternalParseMode = IParseMode { iParseFilename :: String, iExtensions :: [KnownExtension], iIgnoreLanguagePragmas :: Bool, iIgnoreLinePragmas :: Bool, iFixities :: Maybe [Fixity] } toInternalParseMode :: ParseMode -> InternalParseMode toInternalParseMode (ParseMode pf bLang exts ilang iline fx) = IParseMode pf (impliesExts $ toExtensionList bLang exts) ilang iline fx -- | Monad for parsing newtype P a = P { runP :: String -- input string -> Int -- current column -> Int -- current line -> SrcLoc -- location of last token read -> ParseState -- layout info. -> InternalParseMode -- parse parameters -> ParseStatus a } runParserWithMode :: ParseMode -> P a -> String -> ParseResult a {-runParserWithMode mode (P m) s = case m s 0 1 start ([],[],(False,False),[]) mode of Ok _ a -> ParseOk a Failed loc msg -> ParseFailed loc msg where start = SrcLoc { srcFilename = parseFilename mode, srcLine = 1, srcColumn = 1 } -} runParserWithMode mode pm s = fmap fst $ runParserWithModeComments mode pm s runParser :: P a -> String -> ParseResult a runParser = runParserWithMode defaultParseMode runParserWithModeComments :: ParseMode -> P a -> String -> ParseResult (a, [Comment]) runParserWithModeComments mode (P m) s = case m s 0 1 start ([],[],(False,False),[]) (toInternalParseMode mode) of Ok (_,_,_,cs) a -> ParseOk (a, reverse cs) Failed loc msg -> ParseFailed loc msg where start = SrcLoc { srcFilename = parseFilename mode, srcLine = 1, srcColumn = 1 } -- allExts mode@(ParseMode {extensions = es}) = mode { extensions = impliesExts es } -- allExts mode = let imode = to instance Monad P where return a = P $ \_i _x _y _l s _m -> Ok s a P m >>= k = P $ \i x y l s mode -> case m i x y l s mode of Failed loc msg -> Failed loc msg Ok s' a -> runP (k a) i x y l s' mode fail s = P $ \_r _col _line loc _stk _m -> Failed loc s atSrcLoc :: P a -> SrcLoc -> P a P m `atSrcLoc` loc = P $ \i x y _l -> m i x y loc getSrcLoc :: P SrcLoc getSrcLoc = P $ \_i _x _y l s _m -> Ok s l getModuleName :: P String getModuleName = P $ \_i _x _y _l s m -> let fn = iParseFilename m mn = concat $ intersperse "." $ splitPath fn splitPath :: String -> [String] splitPath "" = [] splitPath str = let (l,str') = break ('\\'==) str in case str' of [] -> [removeSuffix l] (_:str'') -> l : splitPath str'' removeSuffix l = reverse $ tail $ dropWhile ('.'/=) $ reverse l in Ok s mn -- Enter a new layout context. If we are already in a layout context, -- ensure that the new indent is greater than the indent of that context. -- (So if the source loc is not to the right of the current indent, an -- empty list {} will be inserted.) pushCurrentContext :: P () pushCurrentContext = do lc <- getSrcLoc indent <- currentIndent dob <- pullDoStatus let loc = srcColumn lc when (dob && loc < indent || not dob && loc <= indent) $ pushCtxtFlag pushContext (Layout loc) currentIndent :: P Int currentIndent = P $ \_r _x _y loc stk _mode -> Ok stk (indentOfParseState stk) pushContext :: LexContext -> P () pushContext ctxt = --trace ("pushing lexical scope: " ++ show ctxt ++"\n") $ P $ \_i _x _y _l (s, e, p, c) _m -> Ok (ctxt:s, e, p, c) () popContext :: P () popContext = P $ \_i _x _y loc stk _m -> case stk of (_:s, e, p, c) -> --trace ("popping lexical scope, context now "++show s ++ "\n") $ Ok (s, e, p, c) () ([],_,_,_) -> Failed loc "Unexpected }" -- error "Internal error: empty context in popContext" -- HaRP/Hsx pushExtContext :: ExtContext -> P () pushExtContext ctxt = P $ \_i _x _y _l (s, e, p, c) _m -> Ok (s, ctxt:e, p, c) () popExtContext :: P () popExtContext = P $ \_i _x _y _l (s, e, p, c) _m -> case e of (_:e') -> Ok (s, e', p, c) () [] -> error "Internal error: empty context in popExtContext" -- Extension-aware lexing/parsing getExtensions :: P [KnownExtension] getExtensions = P $ \_i _x _y _l s m -> Ok s $ iExtensions m pushCtxtFlag :: P () pushCtxtFlag = P $ \_i _x _y _l (s, e, (d,c), cs) _m -> case c of False -> Ok (s, e, (d,True), cs) () _ -> error "Internal error: context flag already pushed" pullDoStatus :: P Bool pullDoStatus = P $ \_i _x _y _l (s, e, (d,c), cs) _m -> Ok (s,e,(False,c),cs) d ---------------------------------------------------------------------------- -- Monad for lexical analysis: -- a continuation-passing version of the parsing monad newtype Lex r a = Lex { runL :: (a -> P r) -> P r } instance Monad (Lex r) where return a = Lex $ \k -> k a Lex v >>= f = Lex $ \k -> v (\a -> runL (f a) k) Lex v >> Lex w = Lex $ \k -> v (\_ -> w k) fail s = Lex $ \_ -> fail s -- Operations on this monad getInput :: Lex r String getInput = Lex $ \cont -> P $ \r -> runP (cont r) r -- | Discard some input characters (these must not include tabs or newlines). discard :: Int -> Lex r () discard n = Lex $ \cont -> P $ \r x -> runP (cont ()) (drop n r) (x+n) -- | Discard the next character, which must be a newline. lexNewline :: Lex a () lexNewline = Lex $ \cont -> P $ \rs _x y loc -> case rs of (_:r) -> runP (cont ()) r 1 (y+1) loc [] -> \_ _ -> Failed loc "Lexer: expected newline." -- | Discard the next character, which must be a tab. lexTab :: Lex a () lexTab = Lex $ \cont -> P $ \(_:r) x -> runP (cont ()) r (nextTab x) nextTab :: Int -> Int nextTab x = x + (tAB_LENGTH - (x-1) `mod` tAB_LENGTH) tAB_LENGTH :: Int tAB_LENGTH = 8 :: Int -- Consume and return the largest string of characters satisfying p lexWhile :: (Char -> Bool) -> Lex a String lexWhile p = Lex $ \cont -> P $ \r x -> let (cs,rest) = span p r in runP (cont cs) rest (x + length cs) -- An alternative scan, to which we can return if subsequent scanning -- is unsuccessful. alternative :: Lex a v -> Lex a (Lex a v) alternative (Lex v) = Lex $ \cont -> P $ \r x y -> runP (cont (Lex $ \cont' -> P $ \_r _x _y -> runP (v cont') r x y)) r x y -- The source location is the coordinates of the previous token, -- or, while scanning a token, the start of the current token. -- col is the current column in the source file. -- We also need to remember between scanning tokens whether we are -- somewhere at the beginning of the line before the first token. -- This could be done with an extra Bool argument to the P monad, -- but as a hack we use a col value of 0 to indicate this situation. -- Setting col to 0 is used in two places: just after emitting a virtual -- close brace due to layout, so that next time through we check whether -- we also need to emit a semi-colon, and at the beginning of the file, -- by runParser, to kick off the lexer. -- Thus when col is zero, the true column can be taken from the loc. checkBOL :: Lex a Bool checkBOL = Lex $ \cont -> P $ \r x y loc -> if x == 0 then runP (cont True) r (srcColumn loc) y loc else runP (cont False) r x y loc setBOL :: Lex a () setBOL = Lex $ \cont -> P $ \r _ -> runP (cont ()) r 0 -- Set the loc to the current position startToken :: Lex a () startToken = Lex $ \cont -> P $ \s x y _ stk mode -> let loc = SrcLoc { srcFilename = iParseFilename mode, srcLine = y, srcColumn = x } in runP (cont ()) s x y loc stk mode -- Current status with respect to the offside (layout) rule: -- LT: we are to the left of the current indent (if any) -- EQ: we are at the current indent (if any) -- GT: we are to the right of the current indent, or not subject to layout getOffside :: Lex a Ordering getOffside = Lex $ \cont -> P $ \r x y loc stk -> runP (cont (compare x (indentOfParseState stk))) r x y loc stk getSrcLocL :: Lex a SrcLoc getSrcLocL = Lex $ \cont -> P $ \i x y l -> runP (cont (l { srcLine = y, srcColumn = x })) i x y l setSrcLineL :: Int -> Lex a () setSrcLineL y = Lex $ \cont -> P $ \i x _ -> runP (cont ()) i x y pushContextL :: LexContext -> Lex a () pushContextL ctxt = Lex $ \cont -> P $ \r x y loc (stk, e, pst, cs) -> runP (cont ()) r x y loc (ctxt:stk, e, pst, cs) popContextL :: String -> Lex a () popContextL fn = Lex $ \cont -> P $ \r x y loc stk m -> case stk of (_:ctxt, e, pst, cs) -> runP (cont ()) r x y loc (ctxt, e, pst, cs) m ([], _, _, _) -> Failed loc "Unexpected }" pullCtxtFlag :: Lex a Bool pullCtxtFlag = Lex $ \cont -> P $ \r x y loc (ct, e, (d,c), cs) -> runP (cont c) r x y loc (ct, e, (d,False), cs) flagDo :: Lex a () flagDo = Lex $ \cont -> P $ \r x y loc (ct, e, (d,c), cs) -> runP (cont ()) r x y loc (ct, e, (True,c), cs) -- Harp/Hsx getExtContext :: Lex a (Maybe ExtContext) getExtContext = Lex $ \cont -> P $ \r x y loc stk@(_, e, _, _) -> let me = case e of [] -> Nothing (c:_) -> Just c in runP (cont me) r x y loc stk pushExtContextL :: ExtContext -> Lex a () pushExtContextL ec = Lex $ \cont -> P $ \r x y loc (s, e, p, c) -> runP (cont ()) r x y loc (s, ec:e, p, c) popExtContextL :: String -> Lex a () popExtContextL fn = Lex $ \cont -> P $ \r x y loc stk@(s,e,p,c) m -> case e of (_:ec) -> runP (cont ()) r x y loc (s,ec,p,c) m [] -> Failed loc ("Internal error: empty tag context in " ++ fn) -- Extension-aware lexing getExtensionsL :: Lex a [KnownExtension] getExtensionsL = Lex $ \cont -> P $ \r x y loc s m -> runP (cont $ iExtensions m) r x y loc s m -- LINE-aware lexing ignoreLinePragmasL :: Lex a Bool ignoreLinePragmasL = Lex $ \cont -> P $ \r x y loc s m -> runP (cont $ iIgnoreLinePragmas m) r x y loc s m -- If we read a file name in a LINE pragma, we should update the state. setLineFilenameL :: String -> Lex a () setLineFilenameL name = Lex $ \cont -> P $ \r x y loc s m -> runP (cont ()) r x y loc s (m {iParseFilename = name}) -- Comments pushComment :: Comment -> Lex a () pushComment c = Lex $ \cont -> P $ \r x y loc (s, e, p, cs) -> runP (cont ()) r x y loc (s, e, p, c:cs) haskell-src-exts-1.14.0/src/Language/Haskell/Exts/ParseUtils.hs0000644000000000000000000011557412204617765022452 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.ParseUtils -- Copyright : (c) Niklas Broberg 2004-2009, -- (c) The GHC Team, 1997-2000 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- Utilities for the Haskell-exts parser. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.ParseUtils ( splitTyConApp -- PType -> P (Name,[Type]) , checkEnabled -- (Show e, Enabled e) => e -> P () , checkPatternGuards -- [Stmt] -> P () , mkRecConstrOrUpdate -- PExp -> [PFieldUpdate] -> P Exp , checkPrec -- Integer -> P Int , checkPContext -- PType -> P PContext , checkContext -- PContext -> P Context , checkAssertion -- PType -> P PAsst , checkDataHeader -- PType -> P (Context,Name,[TyVarBind]) , checkClassHeader -- PType -> P (Context,Name,[TyVarBind]) , checkInstHeader -- PType -> P (Context,QName,[Type]) , checkDeriving -- [PType] -> P [Deriving] , checkPattern -- PExp -> P Pat , checkExpr -- PExp -> P Exp , checkType -- PType -> P Type , checkValDef -- SrcLoc -> PExp -> Maybe Type -> Rhs -> Binds -> P Decl , checkClassBody -- [ClassDecl] -> P [ClassDecl] , checkInstBody -- [InstDecl] -> P [InstDecl] , checkUnQual -- QName -> P Name , checkRevDecls -- [Decl] -> P [Decl] , checkRevClsDecls -- [ClassDecl] -> P [ClassDecl] , checkRevInstDecls -- [InstDecl] -> P [InstDecl] , checkDataOrNew -- DataOrNew -> [QualConDecl] -> P () , checkDataOrNewG -- DataOrNew -> [GadtDecl] -> P () , checkSimpleType -- PType -> P (Name, [TyVarBind]) , checkSigVar -- PExp -> P Name , getGConName -- S.Exp -> P QName , mkTyForall -- Maybe [TyVarBind] -> PContext -> PType -> PType -- HaRP , checkRPattern -- PExp -> P RPat -- Hsx , checkEqNames -- XName -> XName -> P XName , checkPageModule , checkHybridModule , mkDVar -- [String] -> String -- Pragmas , checkRuleExpr -- PExp -> P Exp , readTool -- Maybe String -> Maybe Tool -- Parsed expressions and types , PExp(..), PFieldUpdate(..), ParseXAttr(..), PType(..), PContext, PAsst(..) , p_unit_con -- PExp , p_tuple_con -- Boxed -> Int -> PExp , p_unboxed_singleton_con -- PExp ) where import Language.Haskell.Exts.Annotated.Syntax hiding ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) ) import qualified Language.Haskell.Exts.Annotated.Syntax as S ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) ) import Language.Haskell.Exts.Annotated.Build import Language.Haskell.Exts.ParseSyntax import Language.Haskell.Exts.ParseMonad import Language.Haskell.Exts.Pretty import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.Extension import Language.Haskell.Exts.ExtScheme import Data.List (intersperse) import Data.Maybe (fromJust) import Control.Monad (when,liftM) --- import Debug.Trace (trace) type L = SrcSpanInfo type S = SrcSpan splitTyConApp :: PType L -> P (Name L, [S.Type L]) splitTyConApp t0 = do (n, pts) <- split t0 [] ts <- mapM checkType pts return (n,ts) where split :: PType L -> [PType L] -> P (Name L, [PType L]) split (TyApp _ t u) ts = split t (u:ts) split (TyCon _ (UnQual _ t)) ts = return (t,ts) split (TyInfix l a op b) ts = split (TyCon l op) (a:b:ts) split _ _ = fail "Illegal data/newtype declaration" ----------------------------------------------------------------------------- -- Checking for extensions checkEnabled :: (Show e, Enabled e) => e -> P () checkEnabled e = do exts <- getExtensions if isEnabled e exts then return () else fail $ show e ++ " is not enabled" checkPatternGuards :: [Stmt L] -> P () checkPatternGuards [Qualifier _ _] = return () checkPatternGuards _ = checkEnabled PatternGuards ----------------------------------------------------------------------------- -- Checking contexts -- Check that a context is syntactically correct. Takes care of -- checking for MPTCs, TypeOperators, TypeFamilies (for eq constraints) -- and ImplicitParameters, but leaves checking of the class assertion -- parameters for later. checkPContext :: PType L -> P (PContext L) checkPContext (TyTuple l Boxed ts) = mapM checkAssertion ts >>= return . CxTuple l checkPContext (TyCon l (Special _ (UnitCon _))) = return $ CxEmpty l checkPContext (TyParen l t) = do c <- checkPContext t return $ CxParen l c checkPContext t = do c <- checkAssertion t return $ CxSingle (ann c) c ------------------------------------------------------------------------------------------------------------------- WORKING HERE -- Check a single assertion according to the above, still leaving -- the class assertion parameters for later. checkAssertion :: PType L -> P (PAsst L) -- We cannot even get here unless ImplicitParameters is enabled. checkAssertion (TyPred _ p@(IParam _ _ _)) = return p -- We cannot even get here unless TypeFamilies is enabled. checkAssertion (TyPred _ p@(EqualP _ _ _)) = return p checkAssertion t = checkAssertion' id [] t where -- class assertions must have at least one argument checkAssertion' fl ts (TyCon l c) = do when (length ts /= 1) $ checkEnabled MultiParamTypeClasses when (isSymbol c) $ checkEnabled TypeOperators return $ ClassA (fl l) c ts checkAssertion' fl ts (TyApp l a t) = do -- no check on t at this stage checkAssertion' (const (fl l)) (t:ts) a checkAssertion' fl ts (TyInfix l a op b) = do -- infix operators require TypeOperators checkEnabled TypeOperators return $ InfixA (fl l) a op b checkAssertion' fl ts (TyParen l t) = checkAssertion' (const (fl l)) ts t checkAssertion' _ _ _ = fail "Illegal class assertion" isSymbol :: QName L -> Bool isSymbol (UnQual _ (Symbol _ _)) = True isSymbol (Qual _ _ (Symbol _ _)) = True isSymbol _ = False -- Checks simple contexts for class and instance -- headers. If FlexibleContexts is enabled then -- anything goes, otherwise only tyvars are allowed. checkSContext :: Maybe (PContext L) -> P (Maybe (S.Context L)) checkSContext (Just ctxt) = case ctxt of CxEmpty l -> return $ Just $ S.CxEmpty l CxSingle l a -> checkAsst True a >>= return . Just . S.CxSingle l CxTuple l as -> mapM (checkAsst True) as >>= return . Just . S.CxTuple l CxParen l cx -> checkSContext (Just cx) >>= return . fmap (S.CxParen l) checkSContext _ = return Nothing -- Checks ordinary contexts for sigtypes and data type -- declarations. If FlexibleContexts is enabled then -- anything goes, otherwise only tyvars OR tyvars -- applied to types are allowed. checkContext :: Maybe (PContext L) -> P (Maybe (S.Context L)) checkContext (Just ctxt) = case ctxt of CxEmpty l -> return $ Just $ S.CxEmpty l CxSingle l a -> checkAsst False a >>= return . Just . S.CxSingle l CxTuple l as -> mapM (checkAsst False) as >>= return . Just . S.CxTuple l CxParen l cx -> checkSContext (Just cx) >>= return . fmap (S.CxParen l) checkContext _ = return Nothing checkAsst :: Bool -> PAsst L -> P (S.Asst L) checkAsst isSimple asst = case asst of ClassA l qn pts -> do ts <- mapM (checkAsstParam isSimple) pts return $ S.ClassA l qn ts InfixA l a op b -> do [a,b] <- mapM (checkAsstParam isSimple) [a,b] return $ S.InfixA l a op b IParam l ipn pt -> do t <- checkType pt return $ S.IParam l ipn t EqualP l pa pb -> do a <- checkType pa b <- checkType pb return $ S.EqualP l a b checkAsstParam :: Bool -> PType L -> P (S.Type L) checkAsstParam isSimple t = do exts <- getExtensions if FlexibleContexts `elem` exts then checkType t else case t of TyVar l n -> return $ S.TyVar l n TyApp l pf pt | not isSimple -> do f <- checkAsstParam isSimple pf t <- checkType pt return $ S.TyApp l f t _ -> fail "Malformed context: FlexibleContexts not enabled" ----------------------------------------------------------------------------- -- Checking Headers checkDataHeader :: PType L -> P (Maybe (S.Context L), DeclHead L) checkDataHeader (TyForall _ Nothing cs t) = do dh <- checkSimple "data/newtype" t [] cs <- checkContext cs return (cs,dh) checkDataHeader t = do dh <- checkSimple "data/newtype" t [] return (Nothing,dh) checkClassHeader :: PType L -> P (Maybe (S.Context L), DeclHead L) checkClassHeader (TyForall _ Nothing cs t) = do dh <- checkSimple "class" t [] cs <- checkSContext cs return (cs,dh) checkClassHeader t = do dh <- checkSimple "class" t [] return (Nothing,dh) checkSimple :: String -> PType L -> [TyVarBind L] -> P (DeclHead L) --checkSimple kw (TyApp _ l t) xs | isTyVarBind t = checkSimple kw l (toTyVarBind t : xs) checkSimple kw x@(TyApp _ l t) xs = do tvb <- mkTyVarBind kw t checkSimple kw l (tvb : xs) checkSimple kw x@(TyInfix l t1 (UnQual _ t) t2) [] = do checkEnabled TypeOperators tv1 <- mkTyVarBind kw t1 tv2 <- mkTyVarBind kw t2 return (DHInfix l tv1 t tv2) checkSimple _kw (TyCon l (UnQual _ t)) xs = do case t of Symbol _ _ -> checkEnabled TypeOperators _ -> return () return (DHead l t xs) checkSimple kw (TyParen l t) xs = do dh <- checkSimple kw t xs return (DHParen l dh) checkSimple kw _l _ = fail ("Illegal " ++ kw ++ " declaration") mkTyVarBind :: String -> PType L -> P (TyVarBind L) mkTyVarBind _ (TyVar l n) = return $ UnkindedVar l n mkTyVarBind _ (TyKind l (TyVar _ n) k) = return $ KindedVar l n k mkTyVarBind _ (TyCon l (UnQual _ n@(Symbol _ _))) = checkEnabled TypeOperators >> return (UnkindedVar l n) mkTyVarBind _ (TyKind l (TyCon _ (UnQual _ n@(Symbol _ _))) k) = checkEnabled TypeOperators >> return (KindedVar l n k) mkTyVarBind kw _ = fail ("Illegal " ++ kw ++ " declaration") {- isTyVarBind :: PType L -> Bool isTyVarBind (TyVar _ _) = True --isTyVarBind (TyCon _ (UnQual _ n@(Symbol _ _))) = True isTyVarBind (TyKind _ (TyVar _ _) _) = True isTyVarBind _ = False toTyVarBind :: PType L -> TyVarBind L toTyVarBind (TyVar l n) = UnkindedVar l n toTyVarBind (TyKind l (TyVar _ n) k) = KindedVar l n k -} checkInstHeader :: PType L -> P (Maybe (S.Context L), InstHead L) checkInstHeader (TyForall _ Nothing cs t) = do ih <- checkInsts t [] cs <- checkSContext cs return (cs, ih) checkInstHeader t = do ih <- checkInsts t [] return (Nothing, ih) checkInsts :: PType L -> [PType L] -> P (InstHead L) checkInsts (TyApp _ l t) ts = checkInsts l (t:ts) checkInsts (TyCon l c) ts = do when (isSymbol c) $ checkEnabled TypeOperators ts <- checkTypes ts return $ IHead l c ts checkInsts (TyInfix l a op b) [] = do checkEnabled TypeOperators [ta,tb] <- checkTypes [a,b] return $ IHInfix l ta op tb checkInsts (TyParen l t) [] = checkInsts t [] >>= return . IHParen l checkInsts _ _ = fail "Illegal instance declaration" checkDeriving :: [PType L] -> P [InstHead L] checkDeriving = mapM (flip checkInsts []) ----------------------------------------------------------------------------- -- Checking Patterns. -- We parse patterns as expressions and check for valid patterns below, -- converting the expression into a pattern at the same time. checkPattern :: PExp L -> P (Pat L) checkPattern e = checkPat e [] checkPat :: PExp L -> [Pat L] -> P (Pat L) checkPat (Con l c) args = return (PApp l c args) checkPat (App l f x) args = do x <- checkPat x [] checkPat f (x:args) checkPat (InfixApp _ l op r) args | op =~= (QVarOp () (UnQual () (Symbol () "!"))) = do -- We must have BangPatterns on checkEnabled BangPatterns let (e,es) = splitBang r [] ps <- mapM checkPattern (BangPat (ann op) e:es) checkPat l (ps++args) checkPat e [] = case e of Var l (UnQual _ x) -> return (PVar l x) Lit l lit -> return (PLit l lit) InfixApp loc l op r -> case op of QConOp _ c -> do l <- checkPat l [] r <- checkPat r [] return (PInfixApp loc l c r) QVarOp ppos (UnQual _ (Symbol _ "+")) -> do checkEnabled NPlusKPatterns case (l,r) of (Var _ (UnQual _ n@(Ident _ _)), Lit _ (Int kpos k _)) -> do let pp = srcInfoSpan ppos kp = srcInfoSpan kpos return (PNPlusK (loc <** [pp,kp]) n k) _ -> patFail "" _ -> patFail "" TupleSection l bx mes -> if not (any ((==) Nothing) mes) then do ps <- mapM (\e -> checkPat e []) (map fromJust mes) return (PTuple l bx ps) else fail "Illegal tuple section in pattern" List l es -> do ps <- mapM checkRPattern es if all isStdPat ps then return . PList l $ map stripRP ps -- we don't allow truly regular patterns unless the extension is enabled else checkEnabled RegularPatterns >> return (PRPat l $ map fixRPOpPrec ps) where isStdPat :: RPat L -> Bool isStdPat (RPPat _ _) = True isStdPat (RPAs _ _ p) = isStdPat p isStdPat (RPParen _ p) = isStdPat p isStdPat _ = False stripRP :: RPat L -> Pat L stripRP (RPPat _ p) = p stripRP (RPAs l n p) = PAsPat l n (stripRP p) stripRP (RPParen l p) = PParen l (stripRP p) stripRP _ = error "cannot strip RP wrapper if not all patterns are base" Paren l e -> do p <- checkPat e [] return (PParen l p) AsPat l n e -> do p <- checkPat e [] return (PAsPat l n p) WildCard l -> return (PWildCard l) IrrPat l e -> do p <- checkPat e [] return (PIrrPat l p) ViewPat l e p -> do e <- checkExpr e p <- checkPat p [] return (PViewPat l e p) RecConstr l c fs -> do fs <- mapM checkPatField fs return (PRec l c fs) NegApp l1 (Lit l2 lit) -> return (PNeg l1 (PLit l2 lit)) ExpTypeSig l e t -> do -- patterns cannot have signatures unless ScopedTypeVariables is enabled. checkEnabled ScopedTypeVariables p <- checkPat e [] return (PatTypeSig l p t) -- Hsx XTag l n attrs mattr cs -> do pattrs <- mapM checkPAttr attrs pcs <- mapM (\c -> checkPat c []) cs mpattr <- maybe (return Nothing) (\e -> do p <- checkPat e [] return $ Just p) mattr let cps = mkChildrenPat pcs return $ PXTag l n pattrs mpattr cps XETag l n attrs mattr -> do pattrs <- mapM checkPAttr attrs mpattr <- maybe (return Nothing) (\e -> do p <- checkPat e [] return $ Just p) mattr return $ PXETag l n pattrs mpattr XPcdata l pcdata -> return $ PXPcdata l pcdata XExpTag l e -> do p <- checkPat e [] return $ PXPatTag l p XRPats l es -> do rps <- mapM checkRPattern es return (PXRPats l $ map fixRPOpPrec rps) -- Generics ExplTypeArg l qn t -> return $ PExplTypeArg l qn t -- QuasiQuotation QuasiQuote l n q -> return $ PQuasiQuote l n q -- BangPatterns BangPat l e -> do p <- checkPat e [] return $ PBangPat l p PreOp l (QVarOp _ (UnQual _ (Symbol _ "!"))) e -> do checkEnabled BangPatterns p <- checkPat e [] return $ PBangPat l p e -> patFail $ prettyPrint e checkPat e _ = patFail $ prettyPrint e splitBang :: PExp L -> [PExp L] -> (PExp L, [PExp L]) splitBang (App _ f x) es = splitBang f (x:es) splitBang e es = (e, es) checkPatField :: PFieldUpdate L -> P (PatField L) checkPatField (FieldUpdate l n e) = do p <- checkPat e [] return (PFieldPat l n p) checkPatField (FieldPun l n) = return (PFieldPun l n) checkPatField (FieldWildcard l) = return (PFieldWildcard l) checkPAttr :: ParseXAttr L -> P (PXAttr L) checkPAttr (XAttr l n v) = do p <- checkPat v [] return $ PXAttr l n p patFail :: String -> P a patFail s = fail $ "Parse error in pattern: " ++ s checkRPattern :: PExp L -> P (RPat L) checkRPattern e = case e of SeqRP l es -> do rps <- mapM checkRPattern es return $ RPSeq l rps PostOp l e op -> do rpop <- checkRPatOp op rp <- checkRPattern e return $ RPOp l rp rpop GuardRP l e gs -> do rp <- checkPattern e return $ RPGuard l rp gs EitherRP l e1 e2 -> do rp1 <- checkRPattern e1 rp2 <- checkRPattern e2 return $ RPEither l rp1 rp2 CAsRP l n e -> do rp <- checkRPattern e return $ RPCAs l n rp AsPat l n e -> do rp <- checkRPattern e return $ RPAs l n rp Paren l e -> do rp <- checkRPattern e return $ RPParen l rp _ -> do p <- checkPattern e return $ RPPat (ann p) p checkRPatOp :: QOp L -> P (RPatOp L) checkRPatOp o@(QVarOp l (UnQual _ (Symbol _ sym))) = case sym of "*" -> return $ RPStar l "*!" -> return $ RPStarG l "+" -> return $ RPPlus l "+!" -> return $ RPPlusG l "?" -> return $ RPOpt l "?!" -> return $ RPOptG l _ -> rpOpFail o checkRPatOp o = rpOpFail o rpOpFail sym = fail $ "Unrecognized regular pattern operator: " ++ prettyPrint sym fixRPOpPrec :: RPat L -> RPat L fixRPOpPrec rp = case rp of RPOp l rp rpop -> fPrecOp rp (flip (RPOp l) rpop) RPEither l rp1 rp2 -> RPEither l (fixRPOpPrec rp1) (fixRPOpPrec rp2) RPSeq l rps -> RPSeq l $ map fixRPOpPrec rps RPCAs l n rp -> RPCAs l n $ fixRPOpPrec rp RPAs l n rp -> RPAs l n $ fixRPOpPrec rp RPParen l rp -> RPParen l $ fixRPOpPrec rp _ -> rp where fPrecOp :: RPat L -> (RPat L -> RPat L) -> RPat L fPrecOp (RPOp l rp rpop) f = fPrecOp rp (f . flip (RPOp l) rpop) fPrecOp (RPCAs l n rp) f = fPrecAs rp f (RPCAs l n) fPrecOp (RPAs l n rp) f = fPrecAs rp f (RPAs l n) fPrecOp rp f = f $ fixRPOpPrec rp fPrecAs :: RPat L -> (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L fPrecAs (RPCAs l n rp) f g = fPrecAs rp f (g . RPCAs l n) fPrecAs (RPAs l n rp) f g = fPrecAs rp f (g . RPAs l n) fPrecAs rp f g = g . f $ fixRPOpPrec rp mkChildrenPat :: [Pat L] -> [Pat L] mkChildrenPat ps = mkCPAux ps [] where mkCPAux :: [Pat L] -> [Pat L] -> [Pat L] mkCPAux [] qs = reverse qs mkCPAux (p:ps) qs = case p of (PRPat l rps) -> [mkCRP l ps (reverse rps ++ map (\q -> RPPat (ann q) q) qs)] _ -> mkCPAux ps (p:qs) mkCRP :: L -> [Pat L] -> [RPat L] -> Pat L mkCRP l [] rps = PXRPats l $ reverse rps mkCRP _ (p:ps) rps = case p of (PXRPats l rqs) -> mkCRP l ps (reverse rqs ++ rps) _ -> mkCRP (ann p) ps (RPPat (ann p) p : rps) ----------------------------------------------------------------------------- -- Check Expression Syntax checkExpr :: PExp L -> P (S.Exp L) checkExpr e = case e of Var l v -> return $ S.Var l v IPVar l v -> return $ S.IPVar l v Con l c -> return $ S.Con l c Lit l lit -> return $ S.Lit l lit InfixApp l e1 op e2 -> check2Exprs e1 e2 (flip (S.InfixApp l) op) App l e1 e2 -> check2Exprs e1 e2 (S.App l) NegApp l (Lit _ (PrimWord _ i _)) -> fail $ "Parse error: negative primitive word literal: " ++ prettyPrint e NegApp l e -> check1Expr e (S.NegApp l) Lambda loc ps e -> check1Expr e (S.Lambda loc ps) Let l bs e -> check1Expr e (S.Let l bs) If l e1 e2 e3 -> check3Exprs e1 e2 e3 (S.If l) Case l e alts -> do e <- checkExpr e return (S.Case l e alts) Do l stmts -> checkDo stmts >> return (S.Do l stmts) MDo l stmts -> checkDo stmts >> return (S.MDo l stmts) TupleSection l bx mes -> if not (any ((==) Nothing) mes) then checkManyExprs (map fromJust mes) (S.Tuple l bx) else do checkEnabled TupleSections mes' <- mapM mCheckExpr mes return $ S.TupleSection l bx mes' List l es -> checkManyExprs es (S.List l) -- Since we don't parse things as left or right sections, we need to mangle them into that. Paren l e -> case e of PostOp _ e1 op -> check1Expr e1 (flip (S.LeftSection l) op) PreOp _ op e2 -> check1Expr e2 (S.RightSection l op) _ -> check1Expr e (S.Paren l) RecConstr l c fields -> do fields <- mapM checkField fields return (S.RecConstr l c fields) RecUpdate l e fields -> do fields <- mapM checkField fields e <- checkExpr e return (S.RecUpdate l e fields) EnumFrom l e -> check1Expr e (S.EnumFrom l) EnumFromTo l e1 e2 -> check2Exprs e1 e2 (S.EnumFromTo l) EnumFromThen l e1 e2 -> check2Exprs e1 e2 (S.EnumFromThen l) EnumFromThenTo l e1 e2 e3 -> check3Exprs e1 e2 e3 (S.EnumFromThenTo l) -- a parallel list comprehension, which could be just a simple one ParComp l e qualss -> do e <- checkExpr e case qualss of [quals] -> return (S.ListComp l e quals) _ -> return (S.ParComp l e qualss) ExpTypeSig loc e ty -> do e <- checkExpr e return (S.ExpTypeSig loc e ty) --Template Haskell BracketExp l e -> return $ S.BracketExp l e SpliceExp l e -> return $ S.SpliceExp l e TypQuote l q -> return $ S.TypQuote l q VarQuote l q -> return $ S.VarQuote l q QuasiQuote l n q -> return $ S.QuasiQuote l n q -- Hsx XTag l n attrs mattr cs -> do attrs <- mapM checkAttr attrs cs <- mapM checkExpr cs mattr <- maybe (return Nothing) (\e -> checkExpr e >>= return . Just) mattr return $ S.XTag l n attrs mattr cs XETag l n attrs mattr -> do attrs <- mapM checkAttr attrs mattr <- maybe (return Nothing) (\e -> checkExpr e >>= return . Just) mattr return $ S.XETag l n attrs mattr XPcdata l p -> return $ S.XPcdata l p XExpTag l e -> do e <- checkExpr e return $ S.XExpTag l e XChildTag l es -> do es <- mapM checkExpr es return $ S.XChildTag l es -- Pragmas CorePragma l s e -> check1Expr e (S.CorePragma l s) SCCPragma l s e -> check1Expr e (S.SCCPragma l s) GenPragma l s xx yy e -> check1Expr e (S.GenPragma l s xx yy) -- UnknownExpPragma n s -> return $ S.UnknownExpPragma n s -- Arrows Proc l p e -> do e <- checkExpr e return $ S.Proc l p e LeftArrApp l e1 e2 -> check2Exprs e1 e2 (S.LeftArrApp l) RightArrApp l e1 e2 -> check2Exprs e1 e2 (S.RightArrApp l) LeftArrHighApp l e1 e2 -> check2Exprs e1 e2 (S.LeftArrHighApp l) RightArrHighApp l e1 e2 -> check2Exprs e1 e2 (S.RightArrHighApp l) _ -> fail $ "Parse error in expression: " ++ prettyPrint e checkAttr :: ParseXAttr L -> P (S.XAttr L) checkAttr (XAttr l n v) = do v <- checkExpr v return $ S.XAttr l n v checkDo [] = fail "Parse error: Last statement in a do-block must be an expression" checkDo [Qualifier _ _] = return () checkDo (_:xs) = checkDo xs -- type signature for polymorphic recursion!! check1Expr :: PExp L -> (S.Exp L -> a) -> P a check1Expr e1 f = do e1 <- checkExpr e1 return (f e1) check2Exprs :: PExp L -> PExp L -> (S.Exp L -> S.Exp L -> a) -> P a check2Exprs e1 e2 f = do e1 <- checkExpr e1 e2 <- checkExpr e2 return (f e1 e2) check3Exprs :: PExp L -> PExp L -> PExp L -> (S.Exp L -> S.Exp L -> S.Exp L -> a) -> P a check3Exprs e1 e2 e3 f = do e1 <- checkExpr e1 e2 <- checkExpr e2 e3 <- checkExpr e3 return (f e1 e2 e3) checkManyExprs :: [PExp L] -> ([S.Exp L] -> a) -> P a checkManyExprs es f = do es <- mapM checkExpr es return (f es) mCheckExpr :: Maybe (PExp L) -> P (Maybe (S.Exp L)) mCheckExpr Nothing = return Nothing mCheckExpr (Just e) = checkExpr e >>= return . Just checkRuleExpr :: PExp L -> P (S.Exp L) checkRuleExpr = checkExpr readTool :: Maybe String -> Maybe Tool readTool = fmap readC where readC str = case str of "GHC" -> GHC "HUGS" -> HUGS "NHC98" -> NHC98 "YHC" -> YHC "HADDOCK" -> HADDOCK _ -> UnknownTool str checkField :: PFieldUpdate L -> P (S.FieldUpdate L) checkField (FieldUpdate l n e) = check1Expr e (S.FieldUpdate l n) checkField (FieldPun l n) = return $ S.FieldPun l n checkField (FieldWildcard l) = return $ S.FieldWildcard l getGConName :: S.Exp L -> P (QName L) getGConName (S.Con _ n) = return n getGConName (S.List l []) = return (list_cons_name l) getGConName _ = fail "Expression in reification is not a name" ----------------------------------------------------------------------------- -- Check Equation Syntax checkValDef :: L -> PExp L -> Maybe (S.Type L) -> Rhs L -> Maybe (Binds L) -> P (Decl L) checkValDef l lhs optsig rhs whereBinds = do mlhs <- isFunLhs lhs [] let whpt = srcInfoPoints l case mlhs of Just (f,es,b,pts) -> do ps <- mapM checkPattern es let l' = l { srcInfoPoints = pts ++ whpt } case optsig of -- only pattern bindings can have signatures Nothing -> return (FunBind l $ if b then [Match l' f ps rhs whereBinds] else let (a:bs) = ps in [InfixMatch l' a f bs rhs whereBinds]) Just _ -> fail "Cannot give an explicit type signature to a function binding" Nothing -> do lhs <- checkPattern lhs return (PatBind l lhs optsig rhs whereBinds) -- A variable binding is parsed as a PatBind. isFunLhs :: PExp L -> [PExp L] -> P (Maybe (Name L, [PExp L], Bool, [S])) isFunLhs (InfixApp ll l (QVarOp loc (UnQual _ op)) r) es | op =~= (Symbol () "!") = do exts <- getExtensions if BangPatterns `elem` exts then let (b,bs) = splitBang r [] in isFunLhs l (BangPat loc b : bs ++ es) else return $ Just (op, l:r:es, False, []) -- It's actually a definition of the operator ! | otherwise = return $ Just (op, l:r:es, False, []) isFunLhs (App _ (Var _ (UnQual _ f)) e) es = return $ Just (f, e:es, True, []) isFunLhs (App _ f e) es = isFunLhs f (e:es) isFunLhs (Var _ (UnQual _ f)) es@(_:_) = return $ Just (f, es, True, []) isFunLhs (Paren l f) es@(_:_) = do mlhs <- isFunLhs f es case mlhs of Just (f,es,b,pts) -> let [x,y] = srcInfoPoints l in return $ Just (f,es,b,x:pts++[y]) _ -> return Nothing isFunLhs _ _ = return Nothing -- Separating between signature declarations and value definitions in -- a post-processing step checkSigVar :: PExp L -> P (Name L) checkSigVar (Var _ (UnQual _ n)) = return n checkSigVar e = fail $ "Left-hand side of type signature is not a variable: " ++ prettyPrint e ----------------------------------------------------------------------------- -- In a class or instance body, a pattern binding must be of a variable. checkClassBody :: [ClassDecl L] -> P [ClassDecl L] checkClassBody decls = do mapM_ checkClassMethodDef decls return decls where checkClassMethodDef (ClsDecl _ decl) = checkMethodDef decl checkClassMethodDef _ = return () checkInstBody :: [InstDecl L] -> P [InstDecl L] checkInstBody decls = do mapM_ checkInstMethodDef decls return decls where checkInstMethodDef (InsDecl _ decl) = checkMethodDef decl checkInstMethodDef _ = return () checkMethodDef :: Decl L -> P () checkMethodDef (PatBind _ (PVar _ _) _ _ _) = return () checkMethodDef (PatBind loc _ _ _ _) = fail "illegal method definition" `atSrcLoc` fromSrcInfo loc checkMethodDef _ = return () ----------------------------------------------------------------------------- -- Check that an identifier or symbol is unqualified. -- For occasions when doing this in the grammar would cause conflicts. checkUnQual :: QName L -> P (Name L) checkUnQual (Qual _ _ _) = fail "Illegal qualified name" checkUnQual (UnQual _ n) = return n checkUnQual (Special _ _) = fail "Illegal special name" ----------------------------------------------------------------------------- -- Check that two xml tag names are equal checkEqNames :: XName L -> XName L -> P (XName L) checkEqNames n@(XName _ n1) (XName _ n2) | n1 == n2 = return n checkEqNames n@(XDomName _ d1 n1) (XDomName _ d2 n2) | n1 == n2 && d1 == d2 = return n checkEqNames n m = fail $ "opening tag '" ++ showTag n ++ "' does not match closing tag '" ++ showTag m ++ "'" where showTag (XName _ n) = n showTag (XDomName _ d n) = d ++ ":" ++ n ----------------------------------------------------------------------------- -- Miscellaneous utilities checkPrec :: Integer -> P Int checkPrec i | 0 <= i && i <= 9 = return (fromInteger i) checkPrec i | otherwise = fail ("Illegal precedence " ++ show i) mkRecConstrOrUpdate :: PExp L -> [PFieldUpdate L] -> P (PExp L) mkRecConstrOrUpdate (Con l c) fs = return (RecConstr l c fs) mkRecConstrOrUpdate e fs@(_:_) = return (RecUpdate (ann e) e fs) mkRecConstrOrUpdate _ _ = fail "Empty record update" ----------------------------------------------------------------------------- -- Reverse a list of declarations, merging adjacent FunBinds of the -- same name and checking that their arities match. checkRevDecls :: [Decl L] -> P [Decl L] checkRevDecls = mergeFunBinds [] where mergeFunBinds revDs [] = return revDs mergeFunBinds revDs (FunBind l ms1@(Match _ name ps _ _:_):ds1) = mergeMatches ms1 ds1 l where arity = length ps mergeMatches ms' (FunBind _ ms@(Match loc name' ps' _ _:_):ds) l | name' =~= name = if length ps' /= arity then fail ("arity mismatch for '" ++ prettyPrint name ++ "'") `atSrcLoc` fromSrcInfo loc else mergeMatches (ms++ms') ds (loc <++> l) mergeMatches ms' ds l = mergeFunBinds (FunBind l ms':revDs) ds mergeFunBinds revDs (FunBind l ims1@(InfixMatch _ _ name _ _ _:_):ds1) = mergeInfix ims1 ds1 l where mergeInfix ims' (FunBind _ ims@(InfixMatch loc _ name' _ _ _:_):ds) l | name' =~= name = mergeInfix (ims++ims') ds (loc <++> l) mergeInfix ms' ds l = mergeFunBinds (FunBind l ms':revDs) ds mergeFunBinds revDs (d:ds) = mergeFunBinds (d:revDs) ds checkRevClsDecls :: [ClassDecl L] -> P [ClassDecl L] checkRevClsDecls = mergeClsFunBinds [] where mergeClsFunBinds revDs [] = return revDs mergeClsFunBinds revDs (ClsDecl l (FunBind _ ms1@(Match _ name ps _ _:_)):ds1) = mergeMatches ms1 ds1 l where arity = length ps mergeMatches ms' (ClsDecl _ (FunBind _ ms@(Match loc name' ps' _ _:_)):ds) l | name' =~= name = if length ps' /= arity then fail ("arity mismatch for '" ++ prettyPrint name ++ "'") `atSrcLoc` fromSrcInfo loc else mergeMatches (ms++ms') ds (loc <++> l) mergeMatches ms' ds l = mergeClsFunBinds (ClsDecl l (FunBind l ms'):revDs) ds mergeClsFunBinds revDs (ClsDecl l (FunBind _ ims1@(InfixMatch _ _ name _ _ _:_)):ds1) = mergeInfix ims1 ds1 l where mergeInfix ims' (ClsDecl _ (FunBind _ ims@(InfixMatch loc _ name' _ _ _:_)):ds) l | name' =~= name = mergeInfix (ims++ims') ds (loc <++> l) mergeInfix ms' ds l = mergeClsFunBinds (ClsDecl l (FunBind l ms'):revDs) ds mergeClsFunBinds revDs (d:ds) = mergeClsFunBinds (d:revDs) ds checkRevInstDecls :: [InstDecl L] -> P [InstDecl L] checkRevInstDecls = mergeInstFunBinds [] where mergeInstFunBinds :: [InstDecl L] -> [InstDecl L] -> P [InstDecl L] mergeInstFunBinds revDs [] = return revDs mergeInstFunBinds revDs (InsDecl l (FunBind _ ms1@(Match _ name ps _ _:_)):ds1) = mergeMatches ms1 ds1 l where arity = length ps mergeMatches ms' (InsDecl _ (FunBind _ ms@(Match loc name' ps' _ _:_)):ds) l | name' =~= name = if length ps' /= arity then fail ("arity mismatch for '" ++ prettyPrint name ++ "'") `atSrcLoc` fromSrcInfo loc else mergeMatches (ms++ms') ds (loc <++> l) mergeMatches ms' ds l = mergeInstFunBinds (InsDecl l (FunBind l ms'):revDs) ds mergeInstFunBinds revDs (InsDecl l (FunBind _ ims1@(InfixMatch _ _ name _ _ _:_)):ds1) = mergeInfix ims1 ds1 l where mergeInfix ims' (InsDecl _ (FunBind _ ims@(InfixMatch loc _ name' _ _ _:_)):ds) l | name' =~= name = mergeInfix (ims++ims') ds (loc <++> l) mergeInfix ms' ds l = mergeInstFunBinds (InsDecl l (FunBind l ms'):revDs) ds mergeInstFunBinds revDs (d:ds) = mergeInstFunBinds (d:revDs) ds ---------------------------------------------------------------- -- Check that newtype declarations have -- the right number (1) of constructors checkDataOrNew :: DataOrNew L -> [QualConDecl L] -> P () checkDataOrNew (DataType _) _ = return () checkDataOrNew (NewType _) [QualConDecl _ _ _ x] = cX x >> return () where cX (ConDecl _ _ [_]) = return () cX (RecDecl _ _ [_]) = return () cX _ = fail "newtype declaration constructor must have exactly one parameter." checkDataOrNew _ _ = fail "newtype declaration must have exactly one constructor." checkDataOrNewG :: DataOrNew L -> [GadtDecl L] -> P () checkDataOrNewG (DataType _) _ = return () checkDataOrNewG (NewType _) [x] = return () checkDataOrNewG _ _ = fail "newtype declaration must have exactly one constructor." checkSimpleType :: PType L -> P (DeclHead L) checkSimpleType t = checkSimple "test" t [] --------------------------------------- -- Check actual types checkType :: PType L -> P (S.Type L) checkType t = checkT t False checkT :: PType L -> Bool -> P (S.Type L) checkT t simple = case t of TyForall l tvs@Nothing cs pt -> do when (simple) $ checkEnabled ExplicitForAll ctxt <- checkContext cs check1Type pt (S.TyForall l Nothing ctxt) TyForall l tvs cs pt -> do checkEnabled ExplicitForAll ctxt <- checkContext cs check1Type pt (S.TyForall l tvs ctxt) TyFun l at rt -> check2Types at rt (S.TyFun l) TyTuple l b pts -> checkTypes pts >>= return . S.TyTuple l b TyList l pt -> check1Type pt (S.TyList l) TyApp l ft at -> check2Types ft at (S.TyApp l) TyVar l n -> return $ S.TyVar l n TyCon l n -> do when (isSymbol n) $ checkEnabled TypeOperators return $ S.TyCon l n TyParen l pt -> check1Type pt (S.TyParen l) -- Here we know that t will be used as an actual type (and not a data constructor) -- so we can check that TypeOperators are enabled. TyInfix l at op bt -> checkEnabled TypeOperators >> check2Types at bt (flip (S.TyInfix l) op) TyKind l pt k -> check1Type pt (flip (S.TyKind l) k) -- TyPred cannot be a valid type _ -> fail $ "Parse error in type: " ++ prettyPrint t check1Type :: PType L -> (S.Type L -> S.Type L) -> P (S.Type L) check1Type pt f = checkT pt True >>= return . f check2Types :: PType L -> PType L -> (S.Type L -> S.Type L -> S.Type L) -> P (S.Type L) check2Types at bt f = checkT at True >>= \a -> checkT bt True >>= \b -> return (f a b) checkTypes :: [PType L] -> P [S.Type L] checkTypes = mapM (flip checkT True) --------------------------------------- -- Converting a complete page checkPageModule :: PExp L -> ([ModulePragma L],[S],L) -> P (Module L) checkPageModule xml (os,ss,inf) = do mod <- getModuleName xml <- checkExpr xml case xml of S.XTag l xn ats mattr cs -> return $ XmlPage (inf<++>l<**(srcInfoPoints l ++ ss)) (ModuleName l mod) os xn ats mattr cs S.XETag l xn ats mattr -> return $ XmlPage (inf<++>l<**(srcInfoPoints l ++ ss)) (ModuleName l mod) os xn ats mattr [] checkHybridModule :: PExp L -> Module L -> S -> S -> P (Module L) checkHybridModule xml (Module inf mh os is ds) s1 s2 = do xml <- checkExpr xml case xml of S.XTag l xn ats mattr cs -> return $ XmlHybrid (inf<++>l<**(s1 : srcInfoPoints inf ++ s2 : srcInfoPoints l)) mh os is ds xn ats mattr cs S.XETag l xn ats mattr -> return $ XmlHybrid (inf<++>l<**(s1 : srcInfoPoints inf ++ s2 : srcInfoPoints l)) mh os is ds xn ats mattr [] --------------------------------------- -- Handle dash-identifiers mkDVar :: [String] -> String mkDVar = concat . intersperse "-" --------------------------------------- -- Combine adjacent for-alls. NO! -- -- A valid type must have one for-all at the top of the type, or of the fn arg types mkTyForall :: L -> Maybe [TyVarBind L] -> Maybe (PContext L) -> PType L -> PType L mkTyForall l mtvs ctxt ty = TyForall l mtvs ctxt ty haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Fixity.hs0000644000000000000000000004114412204617765021622 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Fixity -- Copyright : (c) Niklas Broberg 2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- Fixity information to give the parser so that infix operators can -- be parsed properly. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Fixity ( -- * Fixity representation Fixity(..) -- | The following three functions all create lists of -- fixities from textual representations of operators. -- The intended usage is e.g. -- -- > fixs = infixr_ 0 ["$","$!","`seq`"] -- -- Note that the operators are expected as you would -- write them infix, i.e. with ` characters surrounding -- /varid/ operators, and /varsym/ operators written as is. , infix_, infixl_, infixr_ -- ** Collections of fixities , preludeFixities, baseFixities, prefixMinusFixity -- * Applying fixities to an AST , AppFixity(..) ) where import Language.Haskell.Exts.Syntax import Data.Char (isUpper) import Control.Monad (when, (<=<), liftM, liftM2, liftM3, liftM4) import Data.Traversable (mapM) import Prelude hiding (mapM) #ifdef __GLASGOW_HASKELL__ #ifdef BASE4 import Data.Data hiding (Fixity) #else import Data.Generics (Data(..),Typeable(..)) #endif #endif -- | Operator fixities are represented by their associativity -- (left, right or none) and their precedence (0-9). data Fixity = Fixity Assoc Int QName #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | All AST elements that may include expressions which in turn may -- need fixity tweaking will be instances of this class. class AppFixity ast where -- | Tweak any expressions in the element to account for the -- fixities given. Assumes that all operator expressions are -- fully left associative chains to begin with. applyFixities :: Monad m => [Fixity] -- ^ The fixities to account for. -> ast -- ^ The element to tweak. -> m ast -- ^ The same element, but with operator expressions updated, or a failure. instance AppFixity Exp where applyFixities fixs = infFix fixs <=< leafFix fixs where -- This is the real meat case. We can assume a left-associative list to begin with. infFix fixs (InfixApp a op2 z) = do e <- infFix fixs a let fixup (a1,p1) (a2,p2) y pre = do when (p1 == p2 && (a1 /= a2 || a1 == AssocNone)) -- Ambiguous infix expression! $ fail "Ambiguous infix expression" if (p1 > p2 || p1 == p2 && (a1 == AssocLeft || a2 == AssocNone)) -- Already right order then return $ InfixApp e op2 z else liftM pre (infFix fixs $ InfixApp y op2 z) case e of InfixApp x op1 y -> fixup (askFixity fixs op1) (askFixity fixs op2) y (InfixApp x op1) NegApp y -> fixup prefixMinusFixity (askFixity fixs op2) y NegApp _ -> return $ InfixApp e op2 z infFix _ e = return e instance AppFixity Pat where applyFixities fixs = infFix fixs <=< leafFixP fixs where -- Same for patterns infFix fixs (PInfixApp a op2 z) = do p <- infFix fixs a let fixup (a1,p1) (a2,p2) y pre = do when (p1 == p2 && (a1 /= a2 || a1 == AssocNone )) -- Ambiguous infix expression! $ fail "Ambiguous infix expression" if (p1 > p2 || p1 == p2 && (a1 == AssocLeft || a2 == AssocNone)) -- Already right order then return $ PInfixApp p op2 z else liftM pre (infFix fixs $ PInfixApp y op2 z) case p of PInfixApp x op1 y -> fixup (askFixityP fixs op1) (askFixityP fixs op2) y (PInfixApp x op1) PNeg y -> fixup prefixMinusFixity (askFixityP fixs op2) y PNeg _ -> return $ PInfixApp p op2 z infFix _ p = return p -- Internal: lookup associativity and precedence of an operator askFixity :: [Fixity] -> QOp -> (Assoc, Int) askFixity xs k = askFix xs (f k) -- undefined -- \k -> askFixityP xs (f k) -- lookupWithDefault (AssocLeft, 9) (f k) mp where f (QVarOp x) = g x f (QConOp x) = g x g (Special Cons) = UnQual (Symbol ":") g x = x -- Same using patterns askFixityP :: [Fixity] -> QName -> (Assoc, Int) askFixityP xs qn = askFix xs (g qn) where g (Special Cons) = UnQual (Symbol ":") g x = x askFix :: [Fixity] -> QName -> (Assoc, Int) askFix xs = \k -> lookupWithDefault (AssocLeft, 9) k mp where lookupWithDefault def k mp = case lookup k mp of Nothing -> def Just x -> x mp = [(x,(a,p)) | Fixity a p x <- xs] -- | Built-in fixity for prefix minus prefixMinusFixity :: (Assoc, Int) prefixMinusFixity = (AssocLeft, 6) -- | All fixities defined in the Prelude. preludeFixities :: [Fixity] preludeFixities = concat [infixr_ 9 ["."] ,infixl_ 9 ["!!"] ,infixr_ 8 ["^","^^","**"] ,infixl_ 7 ["*","/","`quot`","`rem`","`div`","`mod`",":%","%"] ,infixl_ 6 ["+","-"] ,infixr_ 5 [":","++"] ,infix_ 4 ["==","/=","<","<=",">=",">","`elem`","`notElem`"] ,infixr_ 3 ["&&"] ,infixr_ 2 ["||"] ,infixl_ 1 [">>",">>="] ,infixr_ 1 ["=<<"] ,infixr_ 0 ["$","$!","`seq`"] ] -- | All fixities defined in the base package. -- -- Note that the @+++@ operator appears in both Control.Arrows and -- Text.ParserCombinators.ReadP. The listed precedence for @+++@ in -- this list is that of Control.Arrows. baseFixities :: [Fixity] baseFixities = preludeFixities ++ concat [infixl_ 9 ["!","//","!:"] ,infixl_ 8 ["`shift`","`rotate`","`shiftL`","`shiftR`","`rotateL`","`rotateR`"] ,infixl_ 7 [".&."] ,infixl_ 6 ["`xor`"] ,infix_ 6 [":+"] ,infixl_ 5 [".|."] ,infixr_ 5 ["+:+","<++","<+>"] -- fixity conflict for +++ between ReadP and Arrow ,infix_ 5 ["\\\\"] ,infixl_ 4 ["<$>","<$","<*>","<*","*>","<**>"] ,infix_ 4 ["`elemP`","`notElemP`"] ,infixl_ 3 ["<|>"] ,infixr_ 3 ["&&&","***"] ,infixr_ 2 ["+++","|||"] ,infixr_ 1 ["<=<",">=>",">>>","<<<","^<<","<<^","^>>",">>^"] ,infixl_ 0 ["`on`"] ,infixr_ 0 ["`par`","`pseq`"] ] infixr_, infixl_, infix_ :: Int -> [String] -> [Fixity] infixr_ = fixity AssocRight infixl_ = fixity AssocLeft infix_ = fixity AssocNone -- Internal: help function for the above definitions. fixity :: Assoc -> Int -> [String] -> [Fixity] fixity a p = map (Fixity a p . op) where op ('`':xs) = UnQual $ Ident $ init xs op xs = UnQual $ Symbol xs ------------------------------------------------------------------- -- Boilerplate - yuck!! Everything below here is internal stuff instance AppFixity Module where applyFixities fixs (Module loc n prs mwt ext imp decls) = liftM (Module loc n prs mwt ext imp) $ appFixDecls fixs decls instance AppFixity Decl where applyFixities fixs decl = case decl of ClassDecl loc ctxt n vars deps cdecls -> liftM (ClassDecl loc ctxt n vars deps) $ mapM fix cdecls InstDecl loc ctxt n ts idecls -> liftM (InstDecl loc ctxt n ts) $ mapM fix idecls SpliceDecl loc spl -> liftM (SpliceDecl loc) $ fix spl FunBind matches -> liftM FunBind $ mapM fix matches PatBind loc p mt rhs bs -> liftM3 (flip (PatBind loc) mt) (fix p) (fix rhs) (fix bs) AnnPragma loc ann -> liftM (AnnPragma loc) $ fix ann _ -> return decl where fix x = applyFixities fixs x appFixDecls :: Monad m => [Fixity] -> [Decl] -> m [Decl] appFixDecls fixs decls = let extraFixs = getFixities decls in mapM (applyFixities (fixs++extraFixs)) decls where getFixities = concatMap getFixity getFixity (InfixDecl _ a p ops) = map (Fixity a p . g) ops getFixity _ = [] g (VarOp x) = UnQual x g (ConOp x) = UnQual x instance AppFixity Annotation where applyFixities fixs ann = case ann of Ann n e -> liftM (Ann n) $ fix e TypeAnn n e -> liftM (TypeAnn n) $ fix e ModuleAnn e -> liftM ModuleAnn $ fix e where fix x = applyFixities fixs x instance AppFixity ClassDecl where applyFixities fixs (ClsDecl decl) = liftM ClsDecl $ applyFixities fixs decl applyFixities _ cdecl = return cdecl instance AppFixity InstDecl where applyFixities fixs (InsDecl decl) = liftM InsDecl $ applyFixities fixs decl applyFixities _ idecl = return idecl instance AppFixity Match where applyFixities fixs (Match loc n ps mt rhs bs) = liftM3 (flip (Match loc n) mt) (mapM fix ps) (fix rhs) (fix bs) where fix x = applyFixities fixs x instance AppFixity Rhs where applyFixities fixs rhs = case rhs of UnGuardedRhs e -> liftM UnGuardedRhs $ fix e GuardedRhss grhss -> liftM GuardedRhss $ mapM fix grhss where fix x = applyFixities fixs x instance AppFixity GuardedRhs where applyFixities fixs (GuardedRhs loc stmts e) = liftM2 (GuardedRhs loc) (mapM fix stmts) $ fix e where fix x = applyFixities fixs x instance AppFixity PatField where applyFixities fixs (PFieldPat n p) = liftM (PFieldPat n) $ applyFixities fixs p applyFixities _ pf = return pf instance AppFixity RPat where applyFixities fixs rp = case rp of RPOp rp op -> liftM (flip RPOp op) (fix rp) RPEither a b -> liftM2 RPEither (fix a) (fix b) RPSeq rps -> liftM RPSeq $ mapM fix rps RPGuard p stmts -> liftM2 RPGuard (fix p) $ mapM fix stmts RPCAs n rp -> liftM (RPCAs n) $ fix rp RPAs n rp -> liftM (RPAs n) $ fix rp RPParen rp -> liftM RPParen $ fix rp RPPat p -> liftM RPPat $ fix p where fix x = applyFixities fixs x instance AppFixity PXAttr where applyFixities fixs (PXAttr n p) = liftM (PXAttr n) $ applyFixities fixs p instance AppFixity Stmt where applyFixities fixs stmt = case stmt of Generator loc p e -> liftM2 (Generator loc) (fix p) (fix e) Qualifier e -> liftM Qualifier $ fix e LetStmt bs -> liftM LetStmt $ fix bs -- special behavior RecStmt stmts -> liftM RecStmt $ mapM fix stmts where fix x = applyFixities fixs x instance AppFixity Binds where applyFixities fixs bs = case bs of BDecls decls -> liftM BDecls $ appFixDecls fixs decls -- special behavior IPBinds ips -> liftM IPBinds $ mapM fix ips where fix x = applyFixities fixs x instance AppFixity IPBind where applyFixities fixs (IPBind loc n e) = liftM (IPBind loc n) $ applyFixities fixs e instance AppFixity FieldUpdate where applyFixities fixs (FieldUpdate n e) = liftM (FieldUpdate n) $ applyFixities fixs e applyFixities _ fup = return fup instance AppFixity Alt where applyFixities fixs (Alt loc p galts bs) = liftM3 (Alt loc) (fix p) (fix galts) (fix bs) where fix x = applyFixities fixs x instance AppFixity GuardedAlts where applyFixities fixs galts = case galts of UnGuardedAlt e -> liftM UnGuardedAlt $ fix e GuardedAlts galts -> liftM GuardedAlts $ mapM fix galts where fix x = applyFixities fixs x instance AppFixity GuardedAlt where applyFixities fixs (GuardedAlt loc stmts e) = liftM2 (GuardedAlt loc) (mapM fix stmts) (fix e) where fix x = applyFixities fixs x instance AppFixity QualStmt where applyFixities fixs qstmt = case qstmt of QualStmt s -> liftM QualStmt $ fix s ThenTrans e -> liftM ThenTrans $ fix e ThenBy e1 e2 -> liftM2 ThenBy (fix e1) (fix e2) GroupBy e -> liftM GroupBy (fix e) GroupUsing e -> liftM GroupUsing (fix e) GroupByUsing e1 e2 -> liftM2 GroupByUsing (fix e1) (fix e2) where fix x = applyFixities fixs x instance AppFixity Bracket where applyFixities fixs br = case br of ExpBracket e -> liftM ExpBracket $ fix e PatBracket p -> liftM PatBracket $ fix p DeclBracket ds -> liftM DeclBracket $ mapM fix ds _ -> return br where fix x = applyFixities fixs x instance AppFixity Splice where applyFixities fixs (ParenSplice e) = liftM ParenSplice $ applyFixities fixs e applyFixities _ s = return s instance AppFixity XAttr where applyFixities fixs (XAttr n e) = liftM (XAttr n) $ applyFixities fixs e -- the boring boilerplate stuff for expressions too -- Recursively fixes the "leaves" of the infix chains, -- without yet touching the chain itself. We assume all chains are -- left-associate to begin with. leafFix fixs e = case e of InfixApp e1 op e2 -> liftM2 (flip InfixApp op) (leafFix fixs e1) (fix e2) App e1 e2 -> liftM2 App (fix e1) (fix e2) NegApp e -> liftM NegApp $ fix e Lambda loc pats e -> liftM2 (Lambda loc) (mapM fix pats) $ fix e Let bs e -> liftM2 Let (fix bs) $ fix e If e a b -> liftM3 If (fix e) (fix a) (fix b) Case e alts -> liftM2 Case (fix e) $ mapM fix alts Do stmts -> liftM Do $ mapM fix stmts MDo stmts -> liftM MDo $ mapM fix stmts Tuple bx exps -> liftM (Tuple bx) $ mapM fix exps List exps -> liftM List $ mapM fix exps Paren e -> liftM Paren $ fix e LeftSection e op -> liftM (flip LeftSection op) (fix e) RightSection op e -> liftM (RightSection op) $ fix e RecConstr n fups -> liftM (RecConstr n) $ mapM fix fups RecUpdate e fups -> liftM2 RecUpdate (fix e) $ mapM fix fups EnumFrom e -> liftM EnumFrom $ fix e EnumFromTo e1 e2 -> liftM2 EnumFromTo (fix e1) (fix e2) EnumFromThen e1 e2 -> liftM2 EnumFromThen (fix e1) (fix e2) EnumFromThenTo e1 e2 e3 -> liftM3 EnumFromThenTo (fix e1) (fix e2) (fix e3) ListComp e quals -> liftM2 ListComp (fix e) $ mapM fix quals ParComp e qualss -> liftM2 ParComp (fix e) $ mapM (mapM fix) qualss ExpTypeSig loc e t -> liftM (flip (ExpTypeSig loc) t) (fix e) BracketExp b -> liftM BracketExp $ fix b SpliceExp s -> liftM SpliceExp $ fix s XTag loc n ats mexp cs -> liftM3 (XTag loc n) (mapM fix ats) (mapM fix mexp) (mapM fix cs) XETag loc n ats mexp -> liftM2 (XETag loc n) (mapM fix ats) (mapM fix mexp) XExpTag e -> liftM XExpTag $ fix e XChildTag loc cs -> liftM (XChildTag loc) $ mapM fix cs Proc loc p e -> liftM2 (Proc loc) (fix p) (fix e) LeftArrApp e1 e2 -> liftM2 LeftArrApp (fix e1) (fix e2) RightArrApp e1 e2 -> liftM2 RightArrApp (fix e1) (fix e2) LeftArrHighApp e1 e2 -> liftM2 LeftArrHighApp (fix e1) (fix e2) RightArrHighApp e1 e2 -> liftM2 RightArrHighApp (fix e1) (fix e2) CorePragma s e -> liftM (CorePragma s) (fix e) SCCPragma s e -> liftM (SCCPragma s) (fix e) GenPragma s ab cd e -> liftM (GenPragma s ab cd) (fix e) _ -> return e where fix x = applyFixities fixs x leafFixP fixs p = case p of PInfixApp p1 op p2 -> liftM2 (flip PInfixApp op) (leafFixP fixs p1) (fix p2) PNeg p -> liftM PNeg $ fix p PApp n ps -> liftM (PApp n) $ mapM fix ps PTuple bx ps -> liftM (PTuple bx) $ mapM fix ps PList ps -> liftM PList $ mapM fix ps PParen p -> liftM PParen $ fix p PRec n pfs -> liftM (PRec n) $ mapM fix pfs PAsPat n p -> liftM (PAsPat n) $ fix p PIrrPat p -> liftM PIrrPat $ fix p PatTypeSig loc p t -> liftM (flip (PatTypeSig loc) t) (fix p) PViewPat e p -> liftM2 PViewPat (fix e) (fix p) PRPat rps -> liftM PRPat $ mapM fix rps PXTag loc n ats mp ps -> liftM3 (PXTag loc n) (mapM fix ats) (mapM fix mp) (mapM fix ps) PXETag loc n ats mp -> liftM2 (PXETag loc n) (mapM fix ats) (mapM fix mp) PXPatTag p -> liftM PXPatTag $ fix p PXRPats rps -> liftM PXRPats $ mapM fix rps PBangPat p -> liftM PBangPat $ fix p _ -> return p where fix x = applyFixities fixs x haskell-src-exts-1.14.0/src/Language/Haskell/Exts/ParseSyntax.hs0000644000000000000000000005010312204617765022622 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} module Language.Haskell.Exts.ParseSyntax where import Language.Haskell.Exts.Annotated.Syntax hiding ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) ) import qualified Language.Haskell.Exts.Annotated.Syntax as S ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) ) --------------------------------------- -- Expressions as we parse them (and patterns, and regular patterns) data PExp l = Var l (QName l) -- ^ variable | IPVar l (IPName l) -- ^ implicit parameter variable | Con l (QName l) -- ^ data constructor | Lit l (Literal l) -- ^ literal constant | InfixApp l (PExp l) (QOp l) (PExp l) -- ^ infix application | App l (PExp l) (PExp l) -- ^ ordinary application | NegApp l (PExp l) -- ^ negation expression @-@ /exp/ | Lambda l [Pat l] (PExp l) -- ^ lambda expression | Let l (Binds l) (PExp l) -- ^ local declarations with @let@ | If l (PExp l) (PExp l) (PExp l) -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/ | Case l (PExp l) [Alt l] -- ^ @case@ /exp/ @of@ /alts/ | Do l [Stmt l] -- ^ @do@-expression: -- the last statement in the list -- should be an expression. | MDo l [Stmt l] -- ^ @mdo@-expression -- | Tuple [PExp] -- ^ tuple expression | TupleSection l Boxed [Maybe (PExp l)] -- ^ tuple section expression, e.g. @(,,3)@ | List l [PExp l] -- ^ list expression | Paren l (PExp l) -- ^ parenthesized expression -- RightSection QOp PExp -- ^ right section @(@/qop/ /exp/@)@ | RecConstr l (QName l) [PFieldUpdate l] -- ^ record construction expression | RecUpdate l (PExp l) [PFieldUpdate l] -- ^ record update expression | EnumFrom l (PExp l) -- ^ unbounded arithmetic sequence, -- incrementing by 1 | EnumFromTo l (PExp l) (PExp l) -- ^ bounded arithmetic sequence, -- incrementing by 1 | EnumFromThen l (PExp l) (PExp l) -- ^ unbounded arithmetic sequence, -- with first two elements given | EnumFromThenTo l (PExp l) (PExp l) (PExp l) -- ^ bounded arithmetic sequence, -- with first two elements given | ParComp l (PExp l) [[QualStmt l]] -- ^ parallel list comprehension | ExpTypeSig l (PExp l) (S.Type l) -- ^ expression type signature | AsPat l (Name l) (PExp l) -- ^ patterns only | WildCard l -- ^ patterns only | IrrPat l (PExp l) -- ^ patterns only -- Post-ops for parsing left sections and regular patterns. Not to be left in the final tree. | PostOp l (PExp l) (QOp l) -- ^ post-ops | PreOp l (QOp l) (PExp l) -- ^ pre-ops -- View patterns | ViewPat l (PExp l) (PExp l) -- ^ patterns only -- HaRP | SeqRP l [PExp l] -- ^ regular patterns only | GuardRP l (PExp l) [Stmt l] -- ^ regular patterns only | EitherRP l (PExp l) (PExp l) -- ^ regular patterns only | CAsRP l (Name l) (PExp l) -- ^ regular patterns only -- Template Haskell | VarQuote l (QName l) -- ^ 'x | TypQuote l (QName l) -- ^ ''T | BracketExp l (Bracket l) | SpliceExp l (Splice l) | QuasiQuote l String String -- ^ [$...|...] -- Hsx | XTag l (XName l) [ParseXAttr l] (Maybe (PExp l)) [PExp l] -- ^ ... | XETag l (XName l) [ParseXAttr l] (Maybe (PExp l)) -- ^ | XPcdata l String -- ^ PCDATA | XExpTag l (PExp l) -- ^ <% ... %> | XChildTag l [PExp l] -- ^ <%> ... | XRPats l [PExp l] -- ^ <[ ... ]> -- Pragmas | CorePragma l String (PExp l) -- ^ {-# CORE #-} pragma | SCCPragma l String (PExp l) -- ^ {-# SCC #-} pragma | GenPragma l String (Int, Int) (Int, Int) (PExp l) -- ^ {-# GENERATED ... #-} pragma -- Generics | ExplTypeArg l (QName l) (S.Type l) -- ^ f {| Int |} x = ... -- Bang Patterns | BangPat l (PExp l) -- ^ f !a = ... -- Arrows | Proc l (Pat l) (PExp l) -- ^ proc p -> do | LeftArrApp l (PExp l) (PExp l) -- ^ e -< e | RightArrApp l (PExp l) (PExp l) -- ^ e >- e | LeftArrHighApp l (PExp l) (PExp l) -- ^ e -<< e | RightArrHighApp l (PExp l) (PExp l) -- ^ e >>- e deriving (Eq,Show) data PFieldUpdate l = FieldUpdate l (QName l) (PExp l) | FieldPun l (Name l) | FieldWildcard l deriving (Eq,Show) data ParseXAttr l = XAttr l (XName l) (PExp l) deriving (Eq,Show) instance Annotated PExp where ann e = case e of Var l qn -> l IPVar l ipn -> l Con l qn -> l Lit l lit -> l InfixApp l e1 qop e2 -> l App l e1 e2 -> l NegApp l e -> l Lambda l ps e -> l Let l bs e -> l If l ec et ee -> l Case l e alts -> l Do l ss -> l MDo l ss -> l TupleSection l bx mes -> l List l es -> l Paren l e -> l RecConstr l qn fups -> l RecUpdate l e fups -> l EnumFrom l e -> l EnumFromTo l ef et -> l EnumFromThen l ef et -> l EnumFromThenTo l ef eth eto -> l ParComp l e qsss -> l ExpTypeSig l e t -> l AsPat l n e -> l WildCard l -> l IrrPat l e -> l PostOp l e op -> l PreOp l op e -> l ViewPat l e1 e2 -> l SeqRP l es -> l GuardRP l e ss -> l EitherRP l e1 e2 -> l CAsRP l n e -> l VarQuote l qn -> l TypQuote l qn -> l BracketExp l br -> l SpliceExp l sp -> l QuasiQuote l sn se -> l XTag l xn xas me es -> l XETag l xn xas me -> l XPcdata l s -> l XExpTag l e -> l XChildTag l es -> l XRPats l es -> l CorePragma l s e -> l SCCPragma l s e -> l GenPragma l s n12 n34 e -> l ExplTypeArg l qn t -> l BangPat l e -> l Proc l p e -> l LeftArrApp l e1 e2 -> l RightArrApp l e1 e2 -> l LeftArrHighApp l e1 e2 -> l RightArrHighApp l e1 e2 -> l amap f e = case e of Var l qn -> Var (f l) qn IPVar l ipn -> IPVar (f l) ipn Con l qn -> Con (f l) qn Lit l lit -> Lit (f l) lit InfixApp l e1 qop e2 -> InfixApp (f l) e1 qop e2 App l e1 e2 -> App (f l) e1 e2 NegApp l e -> NegApp (f l) e Lambda l ps e -> Lambda (f l) ps e Let l bs e -> Let (f l) bs e If l ec et ee -> If (f l) ec et ee Case l e alts -> Case (f l) e alts Do l ss -> Do (f l) ss MDo l ss -> MDo (f l) ss TupleSection l bx mes -> TupleSection (f l) bx mes List l es -> List (f l) es Paren l e -> Paren (f l) e RecConstr l qn fups -> RecConstr (f l) qn fups RecUpdate l e fups -> RecUpdate (f l) e fups EnumFrom l e -> EnumFrom (f l) e EnumFromTo l ef et -> EnumFromTo (f l) ef et EnumFromThen l ef et -> EnumFromThen (f l) ef et EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) ef eth eto ParComp l e qsss -> ParComp (f l) e qsss ExpTypeSig l e t -> ExpTypeSig (f l) e t AsPat l n e -> AsPat (f l) n e WildCard l -> WildCard (f l) IrrPat l e -> IrrPat (f l) e PostOp l e op -> PostOp (f l) e op PreOp l op e -> PreOp (f l) op e ViewPat l e1 e2 -> ViewPat (f l) e1 e2 SeqRP l es -> SeqRP (f l) es GuardRP l e ss -> GuardRP (f l) e ss EitherRP l e1 e2 -> EitherRP (f l) e1 e2 CAsRP l n e -> CAsRP (f l) n e ExplTypeArg l n t -> ExplTypeArg (f l) n t BangPat l e -> BangPat (f l) e VarQuote l qn -> VarQuote (f l) qn TypQuote l qn -> TypQuote (f l) qn BracketExp l br -> BracketExp (f l) br SpliceExp l sp -> SpliceExp (f l) sp QuasiQuote l sn se -> QuasiQuote (f l) sn se XTag l xn xas me es -> XTag (f l) xn xas me es XETag l xn xas me -> XETag (f l) xn xas me XPcdata l s -> XPcdata (f l) s XExpTag l e -> XExpTag (f l) e XChildTag l es -> XChildTag (f l) es XRPats l es -> XRPats (f l) es CorePragma l s e -> CorePragma (f l) s e SCCPragma l s e -> SCCPragma (f l) s e GenPragma l s n12 n34 e -> GenPragma (f l) s n12 n34 e Proc l p e -> Proc (f l) p e LeftArrApp l e1 e2 -> LeftArrApp (f l) e1 e2 RightArrApp l e1 e2 -> RightArrApp (f l) e1 e2 LeftArrHighApp l e1 e2 -> LeftArrHighApp (f l) e1 e2 RightArrHighApp l e1 e2 -> RightArrHighApp (f l) e1 e2 instance Functor PExp where fmap f e = case e of Var l qn -> Var (f l) (fmap f qn) IPVar l ipn -> IPVar (f l) (fmap f ipn) Con l qn -> Con (f l) (fmap f qn) Lit l lit -> Lit (f l) (fmap f lit) InfixApp l e1 qop e2 -> InfixApp (f l) (fmap f e1) (fmap f qop) (fmap f e2) App l e1 e2 -> App (f l) (fmap f e1) (fmap f e2) NegApp l e -> NegApp (f l) (fmap f e) Lambda l ps e -> Lambda (f l) (map (fmap f) ps) (fmap f e) Let l bs e -> Let (f l) (fmap f bs) (fmap f e) If l ec et ee -> If (f l) (fmap f ec) (fmap f et) (fmap f ee) Case l e alts -> Case (f l) (fmap f e) (map (fmap f) alts) Do l ss -> Do (f l) (map (fmap f) ss) MDo l ss -> MDo (f l) (map (fmap f) ss) TupleSection l bx mes -> TupleSection (f l) bx (map (fmap (fmap f)) mes) List l es -> List (f l) (map (fmap f) es) Paren l e -> Paren (f l) (fmap f e) RecConstr l qn fups -> RecConstr (f l) (fmap f qn) (map (fmap f) fups) RecUpdate l e fups -> RecUpdate (f l) (fmap f e) (map (fmap f) fups) EnumFrom l e -> EnumFrom (f l) (fmap f e) EnumFromTo l ef et -> EnumFromTo (f l) (fmap f ef) (fmap f et) EnumFromThen l ef et -> EnumFromThen (f l) (fmap f ef) (fmap f et) EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) (fmap f ef) (fmap f eth) (fmap f eto) ParComp l e qsss -> ParComp (f l) (fmap f e) (map (map (fmap f)) qsss) ExpTypeSig l e t -> ExpTypeSig (f l) (fmap f e) (fmap f t) AsPat l n e -> AsPat (f l) (fmap f n) (fmap f e) WildCard l -> WildCard (f l) IrrPat l e -> IrrPat (f l) (fmap f e) PostOp l e op -> PostOp (f l) (fmap f e) (fmap f op) PreOp l op e -> PreOp (f l) (fmap f op) (fmap f e) ViewPat l e1 e2 -> ViewPat (f l) (fmap f e1) (fmap f e2) SeqRP l es -> SeqRP (f l) (map (fmap f) es) GuardRP l e ss -> GuardRP (f l) (fmap f e) (map (fmap f) ss) EitherRP l e1 e2 -> EitherRP (f l) (fmap f e1) (fmap f e2) CAsRP l n e -> CAsRP (f l) (fmap f n) (fmap f e) ExplTypeArg l n t -> ExplTypeArg (f l) (fmap f n) (fmap f t) BangPat l e -> BangPat (f l) (fmap f e) VarQuote l qn -> VarQuote (f l) (fmap f qn) TypQuote l qn -> TypQuote (f l) (fmap f qn) BracketExp l br -> BracketExp (f l) (fmap f br) SpliceExp l sp -> SpliceExp (f l) (fmap f sp) QuasiQuote l sn se -> QuasiQuote (f l) sn se XTag l xn xas me es -> XTag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es) XETag l xn xas me -> XETag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) XPcdata l s -> XPcdata (f l) s XExpTag l e -> XExpTag (f l) (fmap f e) XChildTag l es -> XChildTag (f l) (map (fmap f) es) XRPats l es -> XRPats (f l) (map (fmap f) es) CorePragma l s e -> CorePragma (f l) s (fmap f e) SCCPragma l s e -> SCCPragma (f l) s (fmap f e) GenPragma l s n12 n34 e -> GenPragma (f l) s n12 n34 (fmap f e) Proc l p e -> Proc (f l) (fmap f p) (fmap f e) LeftArrApp l e1 e2 -> LeftArrApp (f l) (fmap f e1) (fmap f e2) RightArrApp l e1 e2 -> RightArrApp (f l) (fmap f e1) (fmap f e2) LeftArrHighApp l e1 e2 -> LeftArrHighApp (f l) (fmap f e1) (fmap f e2) RightArrHighApp l e1 e2 -> RightArrHighApp (f l) (fmap f e1) (fmap f e2) instance Functor PFieldUpdate where fmap f (FieldUpdate l qn e) = FieldUpdate (f l) (fmap f qn) (fmap f e) fmap f (FieldPun l n) = FieldPun (f l) (fmap f n) fmap f (FieldWildcard l) = FieldWildcard (f l) instance Annotated PFieldUpdate where ann (FieldUpdate l qn e) = l ann (FieldPun l n) = l ann (FieldWildcard l) = l amap f (FieldUpdate l qn e) = FieldUpdate (f l) qn e amap f (FieldPun l n) = FieldPun (f l) n amap f (FieldWildcard l) = FieldWildcard (f l) instance Functor ParseXAttr where fmap f (XAttr l xn e) = XAttr (f l) (fmap f xn) (fmap f e) instance Annotated ParseXAttr where ann (XAttr l _ _) = l amap f (XAttr l xn e) = XAttr (f l) xn e p_unit_con :: l -> PExp l p_unit_con l = Con l (unit_con_name l) p_tuple_con :: l -> Boxed -> Int -> PExp l p_tuple_con l b i = Con l (tuple_con_name l b i) p_unboxed_singleton_con :: l -> PExp l p_unboxed_singleton_con l = Con l (unboxed_singleton_con_name l) data PContext l = CxSingle l (PAsst l) | CxTuple l [PAsst l] | CxParen l (PContext l) | CxEmpty l deriving (Eq, Show) instance Functor PContext where fmap f (CxSingle l asst) = CxSingle (f l) (fmap f asst) fmap f (CxTuple l assts) = CxTuple (f l) (map (fmap f) assts) fmap f (CxParen l ctxt) = CxParen (f l) (fmap f ctxt) fmap f (CxEmpty l) = CxEmpty (f l) instance Annotated PContext where ann (CxSingle l asst ) = l ann (CxTuple l assts) = l ann (CxParen l ctxt ) = l ann (CxEmpty l) = l amap f (CxSingle l asst ) = CxSingle (f l) asst amap f (CxTuple l assts) = CxTuple (f l) assts amap f (CxParen l ctxt ) = CxParen (f l) ctxt amap f (CxEmpty l) = CxEmpty (f l) data PType l = TyForall l (Maybe [TyVarBind l]) (Maybe (PContext l)) (PType l) | TyFun l (PType l) (PType l) -- ^ function type | TyTuple l Boxed [PType l] -- ^ tuple type, possibly boxed | TyList l (PType l) -- ^ list syntax, e.g. [a], as opposed to [] a | TyApp l (PType l) (PType l) -- ^ application of a type constructor | TyVar l (Name l) -- ^ type variable | TyCon l (QName l) -- ^ named type or type constructor | TyParen l (PType l) -- ^ type surrounded by parentheses | TyPred l (PAsst l) -- ^ assertion of an implicit parameter | TyInfix l (PType l) (QName l) (PType l) -- ^ infix type constructor | TyKind l (PType l) (Kind l) -- ^ type with explicit kind signature deriving (Eq, Show) instance Functor PType where fmap f t = case t of TyForall l mtvs mcx t -> TyForall (f l) (fmap (map (fmap f)) mtvs) (fmap (fmap f) mcx) (fmap f t) TyFun l t1 t2 -> TyFun (f l) (fmap f t1) (fmap f t2) TyTuple l b ts -> TyTuple (f l) b (map (fmap f) ts) TyList l t -> TyList (f l) (fmap f t) TyApp l t1 t2 -> TyApp (f l) (fmap f t1) (fmap f t2) TyVar l n -> TyVar (f l) (fmap f n) TyCon l qn -> TyCon (f l) (fmap f qn) TyParen l t -> TyParen (f l) (fmap f t) TyPred l asst -> TyPred (f l) (fmap f asst) TyInfix l ta qn tb -> TyInfix (f l) (fmap f ta) (fmap f qn) (fmap f tb) TyKind l t k -> TyKind (f l) (fmap f t) (fmap f k) instance Annotated PType where ann t = case t of TyForall l mtvs cx t -> l TyFun l t1 t2 -> l TyTuple l b ts -> l TyList l t -> l TyApp l t1 t2 -> l TyVar l n -> l TyCon l qn -> l TyParen l t -> l TyInfix l ta qn tb -> l TyKind l t k -> l amap f t = case t of TyForall l mtvs mcx t -> TyForall (f l) mtvs mcx t TyFun l t1 t2 -> TyFun (f l) t1 t2 TyTuple l b ts -> TyTuple (f l) b ts TyList l t -> TyList (f l) t TyApp l t1 t2 -> TyApp (f l) t1 t2 TyVar l n -> TyVar (f l) n TyCon l qn -> TyCon (f l) qn TyParen l t -> TyParen (f l) t TyInfix l ta qn tb -> TyInfix (f l) ta qn tb TyKind l t k -> TyKind (f l) t k data PAsst l = ClassA l (QName l) [PType l] | InfixA l (PType l) (QName l) (PType l) | IParam l (IPName l) (PType l) | EqualP l (PType l) (PType l) deriving (Eq, Show) instance Functor PAsst where fmap f asst = case asst of ClassA l qn ts -> ClassA (f l) (fmap f qn) (map (fmap f) ts) InfixA l ta qn tb -> InfixA (f l) (fmap f ta) (fmap f qn) (fmap f tb) IParam l ipn t -> IParam (f l) (fmap f ipn) (fmap f t) EqualP l t1 t2 -> EqualP (f l) (fmap f t1) (fmap f t2) instance Annotated PAsst where ann asst = case asst of ClassA l qn ts -> l InfixA l ta qn tb -> l IParam l ipn t -> l EqualP l t1 t2 -> l amap f asst = case asst of ClassA l qn ts -> ClassA (f l) qn ts InfixA l ta qn tb -> InfixA (f l) ta qn tb IParam l ipn t -> IParam (f l) ipn t EqualP l t1 t2 -> EqualP (f l) t1 t2 unit_tycon, fun_tycon, list_tycon, unboxed_singleton_tycon :: l -> PType l unit_tycon l = TyCon l (unit_tycon_name l) fun_tycon l = TyCon l (fun_tycon_name l) list_tycon l = TyCon l (list_tycon_name l) unboxed_singleton_tycon l = TyCon l (unboxed_singleton_tycon_name l) tuple_tycon :: l -> Boxed -> Int -> PType l tuple_tycon l b i = TyCon l (tuple_tycon_name l b i) haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Lexer.hs0000644000000000000000000000262312204617765021424 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Lexer -- Copyright : (c) The GHC Team, 1997-2000 -- (c) Niklas Broberg, 2004-2012 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, niklas.broberg@chalmers.se -- Stability : stable -- Portability : portable -- -- Lexer for Haskell with extensions. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Lexer ( lexTokenStream, lexTokenStreamWithMode, Token(..), Loc(..) ) where import Language.Haskell.Exts.InternalLexer import Language.Haskell.Exts.ParseMonad import Language.Haskell.Exts.SrcLoc -- | Lex a string into a list of Haskell 2010 source tokens. lexTokenStream :: String -> ParseResult [Loc Token] lexTokenStream = lexTokenStreamWithMode defaultParseMode -- | Lex a string into a list of Haskell source tokens, using an explicit mode. lexTokenStreamWithMode :: ParseMode -> String -> ParseResult [Loc Token] lexTokenStreamWithMode mode str = runParserWithMode mode lexIt str where lexIt :: P [Loc Token] lexIt = runL go return go :: Lex [Loc Token] [Loc Token] go = do ltok <- topLexer case ltok of Loc _ EOF -> return [] _ -> do ts <- go return (ltok:ts) haskell-src-exts-1.14.0/src/Language/Haskell/Exts/InternalLexer.hs0000644000000000000000000013660312204617765023127 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Annotated.InternalLexer -- Copyright : (c) The GHC Team, 1997-2000 -- (c) Niklas Broberg, 2004-2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- Lexer for Haskell, with some extensions. -- ----------------------------------------------------------------------------- -- ToDo: Introduce different tokens for decimal, octal and hexadecimal (?) -- ToDo: FloatTok should have three parts (integer part, fraction, exponent) (?) -- ToDo: Use a lexical analyser generator (lx?) module Language.Haskell.Exts.InternalLexer (Token(..), showToken, lexer, topLexer) where import Language.Haskell.Exts.ParseMonad import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.Comments import Language.Haskell.Exts.Extension import Language.Haskell.Exts.ExtScheme import Data.Char import Data.Ratio import Data.List (intersperse) import Control.Monad (when) -- import Debug.Trace (trace) data Token = VarId String | QVarId (String,String) | IDupVarId (String) -- duplicable implicit parameter | ILinVarId (String) -- linear implicit parameter | ConId String | QConId (String,String) | DVarId [String] -- to enable varid's with '-' in them | VarSym String | ConSym String | QVarSym (String,String) | QConSym (String,String) | IntTok (Integer, String) | FloatTok (Rational, String) | Character (Char, String) | StringTok (String, String) | IntTokHash (Integer, String) -- 1# | WordTokHash (Integer, String) -- 1## | FloatTokHash (Rational, String) -- 1.0# | DoubleTokHash (Rational, String) -- 1.0## | CharacterHash (Char, String) -- c# | StringHash (String, String) -- "Hello world!"# -- Symbols | LeftParen | RightParen | LeftHashParen | RightHashParen | LeftCurlyBar | RightCurlyBar | SemiColon | LeftCurly | RightCurly | VRightCurly -- a virtual close brace | LeftSquare | RightSquare | Comma | Underscore | BackQuote -- Reserved operators | Dot -- reserved for use with 'forall x . x' | DotDot | Colon | DoubleColon | Equals | Backslash | Bar | LeftArrow | RightArrow | At | Tilde | DoubleArrow | Minus | Exclamation | Star | LeftArrowTail -- >- | RightArrowTail -- -< | LeftDblArrowTail -- >>- | RightDblArrowTail -- -<< -- Template Haskell | THExpQuote -- [| or [e| | THPatQuote -- [p| | THDecQuote -- [d| | THTypQuote -- [t| | THCloseQuote -- |] | THIdEscape (String) -- dollar x | THParenEscape -- dollar ( | THVarQuote -- 'x (but without the x) | THTyQuote -- ''T (but without the T) | THQuasiQuote (String,String) -- [$...|...] -- HaRP | RPGuardOpen -- (| | RPGuardClose -- |) | RPCAt -- @: -- Hsx | XCodeTagOpen -- <% | XCodeTagClose -- %> | XStdTagOpen -- < | XStdTagClose -- > | XCloseTagOpen -- | XChildTagOpen -- <%> (note that close doesn't exist, it's XCloseTagOpen followed by XCodeTagClose) | XPCDATA String | XRPatOpen -- <[ | XRPatClose -- ]> -- Pragmas | PragmaEnd -- #-} | RULES | INLINE Bool | INLINE_CONLIKE | SPECIALISE | SPECIALISE_INLINE Bool | SOURCE | DEPRECATED | WARNING | SCC | GENERATED | CORE | UNPACK | OPTIONS (Maybe String,String) -- | CFILES String -- | INCLUDE String | LANGUAGE | ANN -- Reserved Ids | KW_As | KW_By -- transform list comprehensions | KW_Case | KW_Class | KW_Data | KW_Default | KW_Deriving | KW_Do | KW_MDo | KW_Else | KW_Family -- indexed type families | KW_Forall -- universal/existential types | KW_Group -- transform list comprehensions | KW_Hiding | KW_If | KW_Import | KW_In | KW_Infix | KW_InfixL | KW_InfixR | KW_Instance | KW_Let | KW_Module | KW_NewType | KW_Of | KW_Proc -- arrows | KW_Rec -- arrows | KW_Then | KW_Type | KW_Using -- transform list comprehensions | KW_Where | KW_Qualified -- FFI | KW_Foreign | KW_Export | KW_Safe | KW_Unsafe | KW_Threadsafe | KW_Interruptible | KW_StdCall | KW_CCall | KW_CPlusPlus | KW_DotNet | KW_Jvm | KW_Js | KW_CApi | EOF deriving (Eq,Show) reserved_ops :: [(String,(Token, Maybe ExtScheme))] reserved_ops = [ ( "..", (DotDot, Nothing) ), ( ":", (Colon, Nothing) ), ( "::", (DoubleColon, Nothing) ), ( "=", (Equals, Nothing) ), ( "\\", (Backslash, Nothing) ), ( "|", (Bar, Nothing) ), ( "<-", (LeftArrow, Nothing) ), ( "->", (RightArrow, Nothing) ), ( "@", (At, Nothing) ), ( "@:", (RPCAt, Just (Any [RegularPatterns])) ), ( "~", (Tilde, Nothing) ), ( "=>", (DoubleArrow, Nothing) ), ( "*", (Star, Just (Any [KindSignatures])) ), -- Arrows notation ( "-<", (LeftArrowTail, Just (Any [Arrows])) ), ( ">-", (RightArrowTail, Just (Any [Arrows])) ), ( "-<<", (LeftDblArrowTail, Just (Any [Arrows])) ), ( ">>-", (RightDblArrowTail, Just (Any [Arrows])) ), -- Unicode notation ( "\x2190", (LeftArrow, Just (Any [UnicodeSyntax])) ), ( "\x2192", (RightArrow, Just (Any [UnicodeSyntax])) ), ( "\x21d2", (DoubleArrow, Just (Any [UnicodeSyntax])) ), ( "\x2237", (DoubleColon, Just (Any [UnicodeSyntax])) ), ( "\x2919", (LeftArrowTail, Just (All [UnicodeSyntax, Arrows])) ), ( "\x291a", (RightArrowTail, Just (All [UnicodeSyntax, Arrows])) ), ( "\x291b", (LeftDblArrowTail, Just (All [UnicodeSyntax, Arrows])) ), ( "\x291c", (RightDblArrowTail, Just (All [UnicodeSyntax, Arrows])) ), ( "\x2605", (Star, Just (All [UnicodeSyntax, KindSignatures])) ) ] special_varops :: [(String,(Token, Maybe ExtScheme))] special_varops = [ -- the dot is only a special symbol together with forall, but can still be used as function composition ( ".", (Dot, Just (Any [ExplicitForAll, ExistentialQuantification])) ), ( "-", (Minus, Nothing) ), ( "!", (Exclamation, Nothing) ) ] reserved_ids :: [(String,(Token, Maybe ExtScheme))] reserved_ids = [ ( "_", (Underscore, Nothing) ), ( "by", (KW_By, Just (Any [TransformListComp])) ), ( "case", (KW_Case, Nothing) ), ( "class", (KW_Class, Nothing) ), ( "data", (KW_Data, Nothing) ), ( "default", (KW_Default, Nothing) ), ( "deriving", (KW_Deriving, Nothing) ), ( "do", (KW_Do, Nothing) ), ( "else", (KW_Else, Nothing) ), ( "family", (KW_Family, Just (Any [TypeFamilies])) ), -- indexed type families ( "forall", (KW_Forall, Just (Any [ExplicitForAll, ExistentialQuantification])) ), -- universal/existential quantification ( "group", (KW_Group, Just (Any [TransformListComp])) ), ( "if", (KW_If, Nothing) ), ( "import", (KW_Import, Nothing) ), ( "in", (KW_In, Nothing) ), ( "infix", (KW_Infix, Nothing) ), ( "infixl", (KW_InfixL, Nothing) ), ( "infixr", (KW_InfixR, Nothing) ), ( "instance", (KW_Instance, Nothing) ), ( "let", (KW_Let, Nothing) ), ( "mdo", (KW_MDo, Just (Any [RecursiveDo])) ), ( "module", (KW_Module, Nothing) ), ( "newtype", (KW_NewType, Nothing) ), ( "of", (KW_Of, Nothing) ), ( "proc", (KW_Proc, Just (Any [Arrows])) ), ( "rec", (KW_Rec, Just (Any [Arrows])) ), ( "then", (KW_Then, Nothing) ), ( "type", (KW_Type, Nothing) ), ( "using", (KW_Using, Just (Any [TransformListComp])) ), ( "where", (KW_Where, Nothing) ), -- FFI ( "foreign", (KW_Foreign, Just (Any [ForeignFunctionInterface])) ), -- Unicode ( "\x2200", (KW_Forall, Just (All [UnicodeSyntax, ExplicitForAll])) ) ] special_varids :: [(String,(Token, Maybe ExtScheme))] special_varids = [ ( "as", (KW_As, Nothing) ), ( "qualified", (KW_Qualified, Nothing) ), ( "hiding", (KW_Hiding, Nothing) ), -- FFI ( "export", (KW_Export, Just (Any [ForeignFunctionInterface])) ), ( "safe", (KW_Safe, Just (Any [ForeignFunctionInterface])) ), ( "unsafe", (KW_Unsafe, Just (Any [ForeignFunctionInterface])) ), ( "threadsafe", (KW_Threadsafe, Just (Any [ForeignFunctionInterface])) ), ( "interruptible", (KW_Interruptible, Just (Any [InterruptibleFFI])) ), ( "stdcall", (KW_StdCall, Just (Any [ForeignFunctionInterface])) ), ( "ccall", (KW_CCall, Just (Any [ForeignFunctionInterface])) ), ( "cplusplus", (KW_CPlusPlus, Just (Any [ForeignFunctionInterface])) ), ( "dotnet", (KW_DotNet, Just (Any [ForeignFunctionInterface])) ), ( "jvm", (KW_Jvm, Just (Any [ForeignFunctionInterface])) ), ( "js", (KW_Js, Just (Any [ForeignFunctionInterface])) ), ( "capi", (KW_CApi, Just (Any [CApiFFI])) ) ] pragmas :: [(String,Token)] pragmas = [ ( "rules", RULES ), ( "inline", INLINE True ), ( "noinline", INLINE False ), ( "notinline", INLINE False ), ( "specialise", SPECIALISE ), ( "specialize", SPECIALISE ), ( "source", SOURCE ), ( "deprecated", DEPRECATED ), ( "warning", WARNING ), ( "ann", ANN ), ( "scc", SCC ), ( "generated", GENERATED ), ( "core", CORE ), ( "unpack", UNPACK ), ( "language", LANGUAGE ), ( "options", OPTIONS undefined ) -- we'll tweak it before use - promise! -- ( "cfiles", CFILES undefined ), -- same here... -- ( "include", INCLUDE undefined ) -- ...and here! ] isIdent, isHSymbol :: Char -> Bool isIdent c = isAlpha c || isDigit c || c == '\'' || c == '_' isHSymbol c = c `elem` ":!#%&*./?@\\-" || ((isSymbol c || isPunctuation c) && not (c `elem` "(),;[]`{}_\"'")) matchChar :: Char -> String -> Lex a () matchChar c msg = do s <- getInput if null s || head s /= c then fail msg else discard 1 -- The top-level lexer. -- We need to know whether we are at the beginning of the line to decide -- whether to insert layout tokens. lexer :: (Loc Token -> P a) -> P a lexer = runL topLexer topLexer :: Lex a (Loc Token) topLexer = do b <- pullCtxtFlag if b then -- trace (show cf ++ ": " ++ show VRightCurly) $ -- the lex context state flags that we must do an empty {} - UGLY setBOL >> getSrcLocL >>= \l -> return (Loc (mkSrcSpan l l) VRightCurly) else do bol <- checkBOL (bol, ws) <- lexWhiteSpace bol -- take care of whitespace in PCDATA ec <- getExtContext case ec of -- if there was no linebreak, and we are lexing PCDATA, -- then we want to care about the whitespace. -- We don't bother to test for XmlSyntax, since we -- couldn't end up in ChildCtxt otherwise. Just ChildCtxt | not bol && ws -> getSrcLocL >>= \l -> return $ Loc (mkSrcSpan l l) $ XPCDATA " " _ -> do startToken sl <- getSrcLocL t <- if bol then lexBOL -- >>= \t -> trace ("BOL: " ++ show t) (return t) else lexToken -- >>= \t -> trace (show t) (return t) el <- getSrcLocL return $ Loc (mkSrcSpan sl el) t lexWhiteSpace :: Bool -> Lex a (Bool, Bool) lexWhiteSpace bol = do s <- getInput ignL <- ignoreLinePragmasL case s of -- If we find a recognised pragma, we don't want to treat it as a comment. '{':'-':'#':rest | isRecognisedPragma rest -> return (bol, False) | isLinePragma rest && not ignL -> do (l, fn) <- lexLinePragma setSrcLineL l setLineFilenameL fn lexWhiteSpace True '{':'-':_ -> do loc <- getSrcLocL discard 2 (bol, c) <- lexNestedComment bol "" loc2 <- getSrcLocL pushComment $ Comment True (mkSrcSpan loc loc2) (reverse c) (bol, _) <- lexWhiteSpace bol return (bol, True) '-':'-':s | all (== '-') (takeWhile isHSymbol s) -> do loc <- getSrcLocL discard 2 dashes <- lexWhile (== '-') rest <- lexWhile (/= '\n') s' <- getInput loc2 <- getSrcLocL let com = Comment False (mkSrcSpan loc loc2) $ dashes ++ rest case s' of [] -> pushComment com >> return (False, True) _ -> do pushComment com lexNewline lexWhiteSpace True return (True, True) '\n':_ -> do lexNewline lexWhiteSpace True return (True, True) '\t':_ -> do lexTab (bol, _) <- lexWhiteSpace bol return (bol, True) c:_ | isSpace c -> do discard 1 (bol, _) <- lexWhiteSpace bol return (bol, True) _ -> return (bol, False) isRecognisedPragma, isLinePragma :: String -> Bool isRecognisedPragma str = let pragma = map toLower . takeWhile isAlphaNum . dropWhile isSpace $ str in case lookup pragma pragmas of Nothing -> False _ -> True isLinePragma str = let pragma = map toLower . takeWhile isAlphaNum . dropWhile isSpace $ str in case pragma of "line" -> True _ -> False lexLinePragma :: Lex a (Int, String) lexLinePragma = do discard 3 -- {-# lexWhile isSpace discard 4 -- LINE lexWhile isSpace i <- lexWhile isDigit when (null i) $ fail "Improperly formatted LINE pragma" lexWhile isSpace matchChar '"' "Improperly formatted LINE pragma" fn <- lexWhile (/= '"') matchChar '"' "Impossible - lexLinePragma" lexWhile isSpace mapM (flip matchChar "Improperly formatted LINE pragma") "#-}" lexNewline return (read i, fn) lexNestedComment :: Bool -> String -> Lex a (Bool, String) lexNestedComment bol str = do s <- getInput case s of '-':'}':_ -> discard 2 >> return (bol, str) '{':'-':_ -> do discard 2 (bol, c) <- lexNestedComment bol ("-{" ++ str) -- rest of the subcomment lexNestedComment bol ("}-" ++ c ) -- rest of this comment '\t':_ -> lexTab >> lexNestedComment bol ('\t':str) '\n':_ -> lexNewline >> lexNestedComment True ('\n':str) c:_ -> discard 1 >> lexNestedComment bol (c:str) [] -> fail "Unterminated nested comment" -- When we are lexing the first token of a line, check whether we need to -- insert virtual semicolons or close braces due to layout. lexBOL :: Lex a Token lexBOL = do pos <- getOffside -- trace ("Off: " ++ (show pos)) $ do case pos of LT -> do -- trace "layout: inserting '}'\n" $ -- Set col to 0, indicating that we're still at the -- beginning of the line, in case we need a semi-colon too. -- Also pop the context here, so that we don't insert -- another close brace before the parser can pop it. setBOL popContextL "lexBOL" return VRightCurly EQ -> -- trace "layout: inserting ';'\n" $ return SemiColon GT -> lexToken lexToken :: Lex a Token lexToken = do ec <- getExtContext -- we don't bother to check XmlSyntax since we couldn't -- have ended up in a non-Nothing context if it wasn't -- enabled. case ec of Just HarpCtxt -> lexHarpToken Just TagCtxt -> lexTagCtxt Just CloseTagCtxt -> lexCloseTagCtxt Just ChildCtxt -> lexChildCtxt Just CodeTagCtxt -> lexCodeTagCtxt _ -> lexStdToken lexChildCtxt :: Lex a Token lexChildCtxt = do -- if we ever end up here, then XmlSyntax must be on. s <- getInput case s of '<':'%':'>':_ -> do discard 3 pushExtContextL ChildCtxt return XChildTagOpen '<':'%':_ -> do discard 2 pushExtContextL CodeTagCtxt return XCodeTagOpen '<':'/':_ -> do discard 2 popExtContextL "lexChildCtxt" pushExtContextL CloseTagCtxt return XCloseTagOpen '<':'[':_ -> do discard 2 pushExtContextL HarpCtxt return XRPatOpen '<':_ -> do discard 1 pushExtContextL TagCtxt return XStdTagOpen _ -> lexPCDATA lexPCDATA :: Lex a Token lexPCDATA = do -- if we ever end up here, then XmlSyntax must be on. s <- getInput case s of [] -> return EOF _ -> case s of '\n':_ -> do x <- lexNewline >> lexPCDATA case x of XPCDATA p -> return $ XPCDATA $ '\n':p EOF -> return EOF '<':_ -> return $ XPCDATA "" _ -> do let pcd = takeWhile (\c -> not $ elem c "<\n") s l = length pcd discard l x <- lexPCDATA case x of XPCDATA pcd' -> return $ XPCDATA $ pcd ++ pcd' EOF -> return EOF lexCodeTagCtxt :: Lex a Token lexCodeTagCtxt = do -- if we ever end up here, then XmlSyntax must be on. s <- getInput case s of '%':'>':_ -> do discard 2 popExtContextL "lexCodeTagContext" return XCodeTagClose _ -> lexStdToken lexCloseTagCtxt :: Lex a Token lexCloseTagCtxt = do -- if we ever end up here, then XmlSyntax must be on. s <- getInput case s of '%':'>':_ -> do discard 2 popExtContextL "lexCloseTagCtxt" return XCodeTagClose '>':_ -> do discard 1 popExtContextL "lexCloseTagCtxt" return XStdTagClose _ -> lexStdToken lexTagCtxt :: Lex a Token lexTagCtxt = do -- if we ever end up here, then XmlSyntax must be on. s <- getInput case s of '/':'>':_ -> do discard 2 popExtContextL "lexTagCtxt: Empty tag" return XEmptyTagClose '>':_ -> do discard 1 popExtContextL "lexTagCtxt: Standard tag" pushExtContextL ChildCtxt return XStdTagClose _ -> lexStdToken lexHarpToken :: Lex a Token lexHarpToken = do -- if we ever end up here, then RegularPatterns must be on. s <- getInput case s of ']':'>':_ -> do discard 2 popExtContextL "lexHarpToken" return XRPatClose _ -> lexStdToken lexStdToken :: Lex a Token lexStdToken = do s <- getInput exts <- getExtensionsL let intHash = lexHash IntTok IntTokHash (Right WordTokHash) case s of [] -> return EOF '0':c:d:_ | toLower c == 'o' && isOctDigit d -> do discard 2 (n, str) <- lexOctal con <- intHash return (con (n, '0':c:str)) | toLower c == 'x' && isHexDigit d -> do discard 2 (n, str) <- lexHexadecimal con <- intHash return (con (n, '0':c:str)) -- implicit parameters '?':c:_ | isLower c && ImplicitParams `elem` exts -> do discard 1 id <- lexWhile isIdent return $ IDupVarId id '%':c:_ | isLower c && ImplicitParams `elem` exts -> do discard 1 id <- lexWhile isIdent return $ ILinVarId id -- end implicit parameters -- harp -- '(':'|':c:_ | isHSymbol c -> discard 1 >> return LeftParen '(':'|':c:_ | RegularPatterns `elem` exts && not (isHSymbol c) -> do discard 2 return RPGuardOpen '|':')':_ | RegularPatterns `elem` exts -> do discard 2 return RPGuardClose {- This is handled by the reserved_ops above. '@':':':_ | RegularPatterns `elem` exts -> do discard 2 return RPCAt -} -- template haskell '[':'|':_ | TemplateHaskell `elem` exts -> do discard 2 return $ THExpQuote '[':c:'|':_ | c == 'e' && TemplateHaskell `elem` exts -> do discard 3 return $ THExpQuote | c == 'p' && TemplateHaskell `elem` exts -> do discard 3 return THPatQuote | c == 'd' && TemplateHaskell `elem` exts -> do discard 3 return THDecQuote | c == 't' && TemplateHaskell `elem` exts -> do discard 3 return THTypQuote '[':'$':c:_ | isLower c && QuasiQuotes `elem` exts -> discard 2 >> lexQuasiQuote '[':c:s | isLower c && QuasiQuotes `elem` exts && case dropWhile isIdent s of { '|':_ -> True;_->False} -> discard 1 >> lexQuasiQuote '|':']':_ | TemplateHaskell `elem` exts -> do discard 2 return THCloseQuote '$':c:_ | isLower c && TemplateHaskell `elem` exts -> do discard 1 id <- lexWhile isIdent return $ THIdEscape id | c == '(' && TemplateHaskell `elem` exts -> do discard 2 return THParenEscape -- end template haskell -- hsx '<':'%':c:_ | XmlSyntax `elem` exts -> do case c of '>' -> do discard 3 pushExtContextL ChildCtxt return XChildTagOpen _ -> do discard 2 pushExtContextL CodeTagCtxt return XCodeTagOpen '<':c:_ | isAlpha c && XmlSyntax `elem` exts -> do discard 1 pushExtContextL TagCtxt return XStdTagOpen -- end hsx '(':'#':c:_ | UnboxedTuples `elem` exts && not (isHSymbol c) -> do discard 2 >> return LeftHashParen '#':')':_ | UnboxedTuples `elem` exts -> do discard 2 >> return RightHashParen '{':'|':_ | Generics `elem` exts -> do discard 2 >> return LeftCurlyBar '|':'}':_ | Generics `elem` exts -> do discard 2 >> return RightCurlyBar -- pragmas '{':'-':'#':_ -> do discard 3 >> lexPragmaStart '#':'-':'}':_ -> do discard 3 >> return PragmaEnd c:_ | isDigit c -> lexDecimalOrFloat | isUpper c -> lexConIdOrQual "" | isLower c || c == '_' -> do idents <- lexIdents case idents of [ident] -> case lookup ident (reserved_ids ++ special_varids) of Just (keyword, scheme) -> do -- check if an extension keyword is enabled if isEnabled scheme exts then flagKW keyword >> return keyword else return $ VarId ident Nothing -> return $ VarId ident _ -> return $ DVarId idents | isHSymbol c -> do sym <- lexWhile isHSymbol return $ case lookup sym (reserved_ops ++ special_varops) of Just (t , scheme) -> -- check if an extension op is enabled if isEnabled scheme exts then t else case c of ':' -> ConSym sym _ -> VarSym sym Nothing -> case c of ':' -> ConSym sym _ -> VarSym sym | otherwise -> do discard 1 case c of -- First the special symbols '(' -> return LeftParen ')' -> return RightParen ',' -> return Comma ';' -> return SemiColon '[' -> return LeftSquare ']' -> return RightSquare '`' -> return BackQuote '{' -> do pushContextL NoLayout return LeftCurly '}' -> do popContextL "lexStdToken" return RightCurly '\'' -> lexCharacter '"' -> lexString _ -> fail ("Illegal character \'" ++ show c ++ "\'\n") where lexIdents :: Lex a [String] lexIdents = do ident <- lexWhile isIdent s <- getInput exts <- getExtensionsL case s of -- This is the only way we can get more than one ident in the list -- and it requires XmlSyntax to be on. '-':c:_ | XmlSyntax `elem` exts && isAlpha c -> do discard 1 idents <- lexIdents return $ ident : idents '#':_ | MagicHash `elem` exts -> do discard 1 return [ident ++ "#"] _ -> return [ident] lexQuasiQuote :: Lex a Token lexQuasiQuote = do -- We've seen and dropped [$ already ident <- lexWhile isIdent matchChar '|' "Malformed quasi-quote quoter" body <- lexQQBody return $ THQuasiQuote (ident, body) lexQQBody :: Lex a String lexQQBody = do s <- getInput case s of '\\':']':_ -> do discard 2 str <- lexQQBody return (']':str) '\\':'|':_ -> do discard 2 str <- lexQQBody return ('|':str) '|':']':_ -> discard 2 >> return "" '|':_ -> do discard 1 str <- lexQQBody return ('|':str) ']':_ -> do discard 1 str <- lexQQBody return (']':str) '\\':_ -> do discard 1 str <- lexQQBody return ('\\':str) '\n':_ -> do lexNewline str <- lexQQBody return ('\n':str) [] -> fail "Unexpected end of input while lexing quasi-quoter" _ -> do str <- lexWhile (not . (`elem` "\\|\n")) rest <- lexQQBody return (str++rest) lexPragmaStart :: Lex a Token lexPragmaStart = do lexWhile isSpace pr <- lexWhile isAlphaNum case lookup (map toLower pr) pragmas of Just (INLINE True) -> do s <- getInput case map toLower s of '_':'c':'o':'n':'l':'i':'k':'e':_ -> do discard 8 return $ INLINE_CONLIKE _ -> return $ INLINE True Just SPECIALISE -> do s <- getInput case dropWhile isSpace $ map toLower s of 'i':'n':'l':'i':'n':'e':_ -> do lexWhile isSpace discard 6 return $ SPECIALISE_INLINE True 'n':'o':'i':'n':'l':'i':'n':'e':_ -> do lexWhile isSpace discard 8 return $ SPECIALISE_INLINE False 'n':'o':'t':'i':'n':'l':'i':'n':'e':_ -> do lexWhile isSpace discard 9 return $ SPECIALISE_INLINE False _ -> return SPECIALISE Just (OPTIONS _) -> do -- see, I promised we'd mask out the 'undefined' s <- getInput case s of '_':_ -> do discard 1 com <- lexWhile isIdent rest <- lexRawPragma return $ OPTIONS (Just com, rest) x:_ | isSpace x -> do rest <- lexRawPragma return $ OPTIONS (Nothing, rest) _ -> fail "Malformed Options pragma" {- Just (CFILES _) -> do rest <- lexRawPragma return $ CFILES rest Just (INCLUDE _) -> do rest <- lexRawPragma return $ INCLUDE rest -} Just p -> return p _ -> fail "Internal error: Unrecognised recognised pragma" -- do rawStr <- lexRawPragma -- return $ PragmaUnknown (pr, rawStr) -- no support for unrecognized pragmas, treat as comment -- discard 3 -- #-} -- topLexer -- we just discard it as a comment for now and restart -} lexRawPragma :: Lex a String lexRawPragma = do rpr <- lexRawPragmaAux return $ dropWhile isSpace rpr where lexRawPragmaAux = do rpr <- lexWhile (/='#') s <- getInput case s of '#':'-':'}':_ -> return rpr "" -> fail "End-of-file inside pragma" _ -> do discard 1 rpr' <- lexRawPragma return $ rpr ++ '#':rpr' lexDecimalOrFloat :: Lex a Token lexDecimalOrFloat = do ds <- lexWhile isDigit rest <- getInput exts <- getExtensionsL case rest of ('.':d:_) | isDigit d -> do discard 1 frac <- lexWhile isDigit let num = parseInteger 10 (ds ++ frac) decimals = toInteger (length frac) (exponent, estr) <- do rest2 <- getInput case rest2 of 'e':_ -> lexExponent 'E':_ -> lexExponent _ -> return (0,"") con <- lexHash FloatTok FloatTokHash (Right DoubleTokHash) return $ con ((num%1) * 10^^(exponent - decimals), ds ++ '.':frac ++ estr) e:_ | toLower e == 'e' -> do (exponent, estr) <- lexExponent con <- lexHash FloatTok FloatTokHash (Right DoubleTokHash) return $ con ((parseInteger 10 ds%1) * 10^^exponent, ds ++ estr) '#':'#':_ | MagicHash `elem` exts -> discard 2 >> return (WordTokHash (parseInteger 10 ds, ds)) '#':_ | MagicHash `elem` exts -> discard 1 >> return (IntTokHash (parseInteger 10 ds, ds)) _ -> return (IntTok (parseInteger 10 ds, ds)) where lexExponent :: Lex a (Integer, String) lexExponent = do (e:r) <- getInput discard 1 -- 'e' or 'E' case r of '+':d:_ | isDigit d -> do discard 1 (n, str) <- lexDecimal return (n, e:'+':str) '-':d:_ | isDigit d -> do discard 1 (n, str) <- lexDecimal return (negate n, e:'-':str) d:_ | isDigit d -> lexDecimal >>= \(n,str) -> return (n, e:str) _ -> fail "Float with missing exponent" lexHash :: (b -> Token) -> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token) lexHash a b c = do exts <- getExtensionsL if MagicHash `elem` exts then do r <- getInput case r of '#':'#':_ -> case c of Right c -> discard 2 >> return c Left s -> fail s '#':_ -> discard 1 >> return b _ -> return a else return a lexConIdOrQual :: String -> Lex a Token lexConIdOrQual qual = do con <- lexWhile isIdent let conid | null qual = ConId con | otherwise = QConId (qual,con) qual' | null qual = con | otherwise = qual ++ '.':con just_a_conid <- alternative (return conid) rest <- getInput exts <- getExtensionsL case rest of '.':c:_ | isLower c || c == '_' -> do -- qualified varid? discard 1 ident <- lexWhile isIdent s <- getInput exts <- getExtensionsL ident' <- case s of '#':_ | MagicHash `elem` exts -> discard 1 >> return (ident ++ "#") _ -> return ident case lookup ident' reserved_ids of -- cannot qualify a reserved word Just (_,scheme) | isEnabled scheme exts -> just_a_conid _ -> return (QVarId (qual', ident')) | isUpper c -> do -- qualified conid? discard 1 lexConIdOrQual qual' | isHSymbol c -> do -- qualified symbol? discard 1 sym <- lexWhile isHSymbol exts <- getExtensionsL case lookup sym reserved_ops of -- cannot qualify a reserved operator Just (_,scheme) | isEnabled scheme exts -> just_a_conid _ -> return $ case c of ':' -> QConSym (qual', sym) _ -> QVarSym (qual', sym) '#':cs | null cs || not (isHSymbol $ head cs) && not (isIdent $ head cs) && MagicHash `elem` exts -> do discard 1 case conid of ConId con -> return $ ConId $ con ++ "#" QConId (q,con) -> return $ QConId (q,con ++ "#") _ -> return conid -- not a qualified thing lexCharacter :: Lex a Token lexCharacter = do -- We need to keep track of not only character constants but also TH 'x and ''T -- We've seen ' so far s <- getInput exts <- getExtensionsL case s of '\'':_ | TemplateHaskell `elem` exts -> discard 1 >> return THTyQuote '\\':_ -> do (c,raw) <- lexEscape matchQuote con <- lexHash Character CharacterHash (Left "Double hash not available for character literals") return (con (c, '\\':raw)) c:'\'':_ -> do discard 2 con <- lexHash Character CharacterHash (Left "Double hash not available for character literals") return (con (c, [c])) _ | TemplateHaskell `elem` exts -> return THVarQuote _ -> fail "Improper character constant or misplaced \'" where matchQuote = matchChar '\'' "Improperly terminated character constant" lexString :: Lex a Token lexString = loop ("","") where loop (s,raw) = do r <- getInput exts <- getExtensionsL case r of '\\':'&':_ -> do discard 2 loop (s, '&':'\\':raw) '\\':c:_ | isSpace c -> do discard 1 wcs <- lexWhiteChars matchChar '\\' "Illegal character in string gap" loop (s, '\\':reverse wcs ++ '\\':raw) | otherwise -> do (ce, str) <- lexEscape loop (ce:s, reverse str ++ '\\':raw) '"':'#':_ | MagicHash `elem` exts -> do discard 2 return (StringHash (reverse s, reverse raw)) '"':_ -> do discard 1 return (StringTok (reverse s, reverse raw)) c:_ | c /= '\n' -> do discard 1 loop (c:s, c:raw) _ -> fail "Improperly terminated string" lexWhiteChars :: Lex a String lexWhiteChars = do s <- getInput case s of '\n':_ -> do lexNewline wcs <- lexWhiteChars return $ '\n':wcs '\t':_ -> do lexTab wcs <- lexWhiteChars return $ '\t':wcs c:_ | isSpace c -> do discard 1 wcs <- lexWhiteChars return $ c:wcs _ -> return "" lexEscape :: Lex a (Char, String) lexEscape = do discard 1 r <- getInput case r of -- Production charesc from section B.2 (Note: \& is handled by caller) 'a':_ -> discard 1 >> return ('\a', "a") 'b':_ -> discard 1 >> return ('\b', "b") 'f':_ -> discard 1 >> return ('\f', "f") 'n':_ -> discard 1 >> return ('\n', "n") 'r':_ -> discard 1 >> return ('\r', "r") 't':_ -> discard 1 >> return ('\t', "t") 'v':_ -> discard 1 >> return ('\v', "v") '\\':_ -> discard 1 >> return ('\\', "\\") '"':_ -> discard 1 >> return ('\"', "\"") '\'':_ -> discard 1 >> return ('\'', "\'") -- Production ascii from section B.2 '^':c:_ -> discard 2 >> cntrl c 'N':'U':'L':_ -> discard 3 >> return ('\NUL', "NUL") 'S':'O':'H':_ -> discard 3 >> return ('\SOH', "SOH") 'S':'T':'X':_ -> discard 3 >> return ('\STX', "STX") 'E':'T':'X':_ -> discard 3 >> return ('\ETX', "ETX") 'E':'O':'T':_ -> discard 3 >> return ('\EOT', "EOT") 'E':'N':'Q':_ -> discard 3 >> return ('\ENQ', "ENQ") 'A':'C':'K':_ -> discard 3 >> return ('\ACK', "ACK") 'B':'E':'L':_ -> discard 3 >> return ('\BEL', "BEL") 'B':'S':_ -> discard 2 >> return ('\BS', "BS") 'H':'T':_ -> discard 2 >> return ('\HT', "HT") 'L':'F':_ -> discard 2 >> return ('\LF', "LF") 'V':'T':_ -> discard 2 >> return ('\VT', "VT") 'F':'F':_ -> discard 2 >> return ('\FF', "FF") 'C':'R':_ -> discard 2 >> return ('\CR', "CR") 'S':'O':_ -> discard 2 >> return ('\SO', "SO") 'S':'I':_ -> discard 2 >> return ('\SI', "SI") 'D':'L':'E':_ -> discard 3 >> return ('\DLE', "DLE") 'D':'C':'1':_ -> discard 3 >> return ('\DC1', "DC1") 'D':'C':'2':_ -> discard 3 >> return ('\DC2', "DC2") 'D':'C':'3':_ -> discard 3 >> return ('\DC3', "DC3") 'D':'C':'4':_ -> discard 3 >> return ('\DC4', "DC4") 'N':'A':'K':_ -> discard 3 >> return ('\NAK', "NAK") 'S':'Y':'N':_ -> discard 3 >> return ('\SYN', "SYN") 'E':'T':'B':_ -> discard 3 >> return ('\ETB', "ETB") 'C':'A':'N':_ -> discard 3 >> return ('\CAN', "CAN") 'E':'M':_ -> discard 2 >> return ('\EM', "EM") 'S':'U':'B':_ -> discard 3 >> return ('\SUB', "SUB") 'E':'S':'C':_ -> discard 3 >> return ('\ESC', "ESC") 'F':'S':_ -> discard 2 >> return ('\FS', "FS") 'G':'S':_ -> discard 2 >> return ('\GS', "GS") 'R':'S':_ -> discard 2 >> return ('\RS', "RS") 'U':'S':_ -> discard 2 >> return ('\US', "US") 'S':'P':_ -> discard 2 >> return ('\SP', "SP") 'D':'E':'L':_ -> discard 3 >> return ('\DEL', "DEL") -- Escaped numbers 'o':c:_ | isOctDigit c -> do discard 1 (n, raw) <- lexOctal n <- checkChar n return (n, 'o':raw) 'x':c:_ | isHexDigit c -> do discard 1 (n, raw) <- lexHexadecimal n <- checkChar n return (n, 'x':raw) c:_ | isDigit c -> do (n, raw) <- lexDecimal n <- checkChar n return (n, raw) _ -> fail "Illegal escape sequence" where checkChar n | n <= 0x10FFFF = return (chr (fromInteger n)) checkChar _ = fail "Character constant out of range" -- Production cntrl from section B.2 cntrl :: Char -> Lex a (Char, String) cntrl c | c >= '@' && c <= '_' = return (chr (ord c - ord '@'), '^':c:[]) cntrl _ = fail "Illegal control character" -- assumes at least one octal digit lexOctal :: Lex a (Integer, String) lexOctal = do ds <- lexWhile isOctDigit return (parseInteger 8 ds, ds) -- assumes at least one hexadecimal digit lexHexadecimal :: Lex a (Integer, String) lexHexadecimal = do ds <- lexWhile isHexDigit return (parseInteger 16 ds, ds) -- assumes at least one decimal digit lexDecimal :: Lex a (Integer, String) lexDecimal = do ds <- lexWhile isDigit return (parseInteger 10 ds, ds) -- Stolen from Hugs's Prelude parseInteger :: Integer -> String -> Integer parseInteger radix ds = foldl1 (\n d -> n * radix + d) (map (toInteger . digitToInt) ds) flagKW :: Token -> Lex a () flagKW t = do when (t `elem` [KW_Do, KW_MDo]) $ do exts <- getExtensionsL when (NondecreasingIndentation `elem` exts) $ flagDo ------------------------------------------------------------------ -- "Pretty" printing for tokens showToken :: Token -> String showToken t = case t of VarId s -> s QVarId (q,s) -> q ++ '.':s IDupVarId s -> '?':s ILinVarId s -> '%':s ConId s -> s QConId (q,s) -> q ++ '.':s DVarId ss -> concat $ intersperse "-" ss VarSym s -> s ConSym s -> s QVarSym (q,s) -> q ++ '.':s QConSym (q,s) -> q ++ '.':s IntTok (_, s) -> s FloatTok (_, s) -> s Character (_, s) -> '\'':s ++ "'" StringTok (_, s) -> '"':s ++ "\"" IntTokHash (_, s) -> s ++ "#" WordTokHash (_, s) -> s ++ "##" FloatTokHash (_, s) -> s ++ "#" DoubleTokHash (_, s) -> s ++ "##" CharacterHash (_, s) -> '\'':s ++ "'#" StringHash (_, s) -> '"':s ++ "\"#" LeftParen -> "(" RightParen -> ")" LeftHashParen -> "(#" RightHashParen -> "#)" LeftCurlyBar -> "{|" RightCurlyBar -> "|}" SemiColon -> ";" LeftCurly -> "{" RightCurly -> "}" VRightCurly -> "virtual }" LeftSquare -> "[" RightSquare -> "]" Comma -> "," Underscore -> "_" BackQuote -> "`" Dot -> "." DotDot -> ".." Colon -> ":" DoubleColon -> "::" Equals -> "=" Backslash -> "\\" Bar -> "|" LeftArrow -> "<-" RightArrow -> "->" At -> "@" Tilde -> "~" DoubleArrow -> "=>" Minus -> "-" Exclamation -> "!" Star -> "*" LeftArrowTail -> ">-" RightArrowTail -> "-<" LeftDblArrowTail -> ">>-" RightDblArrowTail -> "-<<" THExpQuote -> "[|" THPatQuote -> "[p|" THDecQuote -> "[d|" THTypQuote -> "[t|" THCloseQuote -> "|]" THIdEscape s -> '$':s THParenEscape -> "$(" THVarQuote -> "'" THTyQuote -> "''" THQuasiQuote (n,q) -> "[$" ++ n ++ "|" ++ q ++ "]" RPGuardOpen -> "(|" RPGuardClose -> "|)" RPCAt -> "@:" XCodeTagOpen -> "<%" XCodeTagClose -> "%>" XStdTagOpen -> "<" XStdTagClose -> ">" XCloseTagOpen -> " "/>" XPCDATA s -> "PCDATA " ++ s XRPatOpen -> "<[" XRPatClose -> "]>" PragmaEnd -> "#-}" RULES -> "{-# RULES" INLINE b -> "{-# " ++ if b then "INLINE" else "NOINLINE" INLINE_CONLIKE -> "{-# " ++ "INLINE_CONLIKE" SPECIALISE -> "{-# SPECIALISE" SPECIALISE_INLINE b -> "{-# SPECIALISE " ++ if b then "INLINE" else "NOINLINE" SOURCE -> "{-# SOURCE" DEPRECATED -> "{-# DEPRECATED" WARNING -> "{-# WARNING" SCC -> "{-# SCC" GENERATED -> "{-# GENERATED" CORE -> "{-# CORE" UNPACK -> "{-# UNPACK" OPTIONS (mt,s) -> "{-# OPTIONS" ++ maybe "" (':':) mt ++ " ..." -- CFILES s -> "{-# CFILES ..." -- INCLUDE s -> "{-# INCLUDE ..." LANGUAGE -> "{-# LANGUAGE" ANN -> "{-# ANN" KW_As -> "as" KW_By -> "by" KW_Case -> "case" KW_Class -> "class" KW_Data -> "data" KW_Default -> "default" KW_Deriving -> "deriving" KW_Do -> "do" KW_MDo -> "mdo" KW_Else -> "else" KW_Family -> "family" KW_Forall -> "forall" KW_Group -> "group" KW_Hiding -> "hiding" KW_If -> "if" KW_Import -> "import" KW_In -> "in" KW_Infix -> "infix" KW_InfixL -> "infixl" KW_InfixR -> "infixr" KW_Instance -> "instance" KW_Let -> "let" KW_Module -> "module" KW_NewType -> "newtype" KW_Of -> "of" KW_Proc -> "proc" KW_Rec -> "rec" KW_Then -> "then" KW_Type -> "type" KW_Using -> "using" KW_Where -> "where" KW_Qualified -> "qualified" KW_Foreign -> "foreign" KW_Export -> "export" KW_Safe -> "safe" KW_Unsafe -> "unsafe" KW_Threadsafe -> "threadsafe" KW_Interruptible -> "interruptible" KW_StdCall -> "stdcall" KW_CCall -> "ccall" EOF -> "EOF" haskell-src-exts-1.14.0/src/Language/Haskell/Exts/ExtScheme.hs0000644000000000000000000000214112204617765022225 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.ExtScheme -- Copyright : (c) Niklas Broberg 2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- Internal scheme for handling extensions in a -- convenient fashion. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.ExtScheme where import Language.Haskell.Exts.Extension data ExtScheme = Any [KnownExtension] | All [KnownExtension] deriving (Eq,Show) type MExtScheme = Maybe ExtScheme class Enabled a where isEnabled :: a -> [KnownExtension] -> Bool instance Enabled KnownExtension where isEnabled = elem instance Enabled ExtScheme where isEnabled (Any exts) enabled = any (`elem` enabled) exts isEnabled (All exts) enabled = all (`elem` enabled) exts instance Enabled a => Enabled (Maybe a) where isEnabled Nothing = const True isEnabled (Just a) = isEnabled a haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Build.hs0000644000000000000000000002057412204617765021411 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Build -- Copyright : (c) The GHC Team, 1997-2000, -- (c) Niklas Broberg 2004 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : experimental -- Portability : portable -- -- This module contains combinators to use when building -- Haskell source trees programmatically, as opposed to -- parsing them from a string. The contents here are quite -- experimental and will likely receive a lot of attention -- when the rest has stabilised. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Build ( -- * Syntax building functions name, -- :: String -> Name sym, -- :: String -> Name var, -- :: Name -> Exp op, -- :: Name -> QOp qvar, -- :: Module -> Name -> Exp pvar, -- :: Name -> Pat app, -- :: Exp -> Exp -> Exp infixApp, -- :: Exp -> QOp -> Exp -> Exp appFun, -- :: Exp -> [Exp] -> Exp pApp, -- :: Name -> [Pat] -> Pat tuple, -- :: [Exp] -> Exp pTuple, -- :: [Pat] -> Pat varTuple, -- :: [Name] -> Exp pvarTuple, -- :: [Name] -> Pat function, -- :: String -> Exp strE, -- :: String -> Exp charE, -- :: Char -> Exp intE, -- :: Integer -> Exp strP, -- :: String -> Pat charP, -- :: Char -> Pat intP, -- :: Integer -> Pat doE, -- :: [Stmt] -> Exp lamE, -- :: SrcLoc -> [Pat] -> Exp -> Exp letE, -- :: [Decl] -> Exp -> Exp caseE, -- :: Exp -> [Alt] -> Exp alt, -- :: SrcLoc -> Pat -> Exp -> Alt altGW, -- :: SrcLoc -> Pat -> [Stmt] -> Exp -> Binds -> Alt listE, -- :: [Exp] -> Exp eList, -- :: Exp peList, -- :: Pat paren, -- :: Exp -> Exp pParen, -- :: Pat -> Pat qualStmt, -- :: Exp -> Stmt genStmt, -- :: SrcLoc -> Pat -> Exp -> Stmt letStmt, -- :: [Decl] -> Stmt binds, -- :: [Decl] -> Binds noBinds, -- :: Binds wildcard, -- :: Pat genNames, -- :: String -> Int -> [Name] -- * More advanced building sfun, -- :: SrcLoc -> Name -> [Name] -> Rhs -> Binds -> Decl simpleFun, -- :: SrcLoc -> Name -> Name -> Exp -> Decl patBind, -- :: SrcLoc -> Pat -> Exp -> Decl patBindWhere, -- :: SrcLoc -> Pat -> Exp -> [Decl] -> Decl nameBind, -- :: SrcLoc -> Name -> Exp -> Decl metaFunction, -- :: String -> [Exp] -> Exp metaConPat -- :: String -> [Pat] -> Pat ) where import Language.Haskell.Exts.Syntax ----------------------------------------------------------------------------- -- Help functions for Abstract syntax -- | An identifier with the given string as its name. -- The string should be a valid Haskell identifier. name :: String -> Name name = Ident -- | A symbol identifier. The string should be a valid -- Haskell symbol identifier. sym :: String -> Name sym = Symbol -- | A local variable as expression. var :: Name -> Exp var = Var . UnQual -- | Use the given identifier as an operator. op :: Name -> QOp op = QVarOp . UnQual -- | A qualified variable as expression. qvar :: ModuleName -> Name -> Exp qvar m n = Var $ Qual m n -- | A pattern variable. pvar :: Name -> Pat pvar = PVar -- | Application of expressions by juxtaposition. app :: Exp -> Exp -> Exp app = App -- | Apply an operator infix. infixApp :: Exp -> QOp -> Exp -> Exp infixApp = InfixApp -- | Apply a function to a list of arguments. appFun :: Exp -> [Exp] -> Exp appFun f [] = f appFun f (a:as) = appFun (app f a) as -- | A constructor pattern, with argument patterns. pApp :: Name -> [Pat] -> Pat pApp n ps = PApp (UnQual n) ps -- | A tuple expression. tuple :: [Exp] -> Exp tuple = Tuple Boxed -- | A tuple pattern. pTuple :: [Pat] -> Pat pTuple = PTuple Boxed -- | A tuple expression consisting of variables only. varTuple :: [Name] -> Exp varTuple ns = tuple $ map var ns -- | A tuple pattern consisting of variables only. pvarTuple :: [Name] -> Pat pvarTuple ns = pTuple $ map pvar ns -- | A function with a given name. function :: String -> Exp function = var . Ident -- | A literal string expression. strE :: String -> Exp strE = Lit . String -- | A literal character expression. charE :: Char -> Exp charE = Lit . Char -- | A literal integer expression. intE :: Integer -> Exp intE = Lit . Int -- | A literal string pattern. strP :: String -> Pat strP = PLit . String -- | A literal character pattern. charP :: Char -> Pat charP = PLit . Char -- | A literal integer pattern. intP :: Integer -> Pat intP = PLit . Int -- | A do block formed by the given statements. -- The last statement in the list should be -- a 'Qualifier' expression. doE :: [Stmt] -> Exp doE = Do -- | Lambda abstraction, given a list of argument -- patterns and an expression body. lamE :: SrcLoc -> [Pat] -> Exp -> Exp lamE = Lambda -- | A @let@ ... @in@ block. letE :: [Decl] -> Exp -> Exp letE ds e = Let (binds ds) e -- | A @case@ expression. caseE :: Exp -> [Alt] -> Exp caseE = Case -- | An unguarded alternative in a @case@ expression. alt :: SrcLoc -> Pat -> Exp -> Alt alt s p e = Alt s p (unGAlt e) noBinds -- | An alternative with a single guard in a @case@ expression. altGW :: SrcLoc -> Pat -> [Stmt] -> Exp -> Binds -> Alt altGW s p gs e w = Alt s p (gAlt s gs e) w -- | An unguarded righthand side of a @case@ alternative. unGAlt :: Exp -> GuardedAlts unGAlt = UnGuardedAlt -- | An list of guarded righthand sides for a @case@ alternative. gAlts :: SrcLoc -> [([Stmt],Exp)] -> GuardedAlts gAlts s as = GuardedAlts $ map (\(gs,e) -> GuardedAlt s gs e) as -- | A single guarded righthand side for a @case@ alternative. gAlt :: SrcLoc -> [Stmt] -> Exp -> GuardedAlts gAlt s gs e = gAlts s [(gs,e)] -- | A list expression. listE :: [Exp] -> Exp listE = List -- | The empty list expression. eList :: Exp eList = List [] -- | The empty list pattern. peList :: Pat peList = PList [] -- | Put parentheses around an expression. paren :: Exp -> Exp paren = Paren -- | Put parentheses around a pattern. pParen :: Pat -> Pat pParen = PParen -- | A qualifier expression statement. qualStmt :: Exp -> Stmt qualStmt = Qualifier -- | A generator statement: /pat/ @<-@ /exp/ genStmt :: SrcLoc -> Pat -> Exp -> Stmt genStmt = Generator -- | A @let@ binding group as a statement. letStmt :: [Decl] -> Stmt letStmt ds = LetStmt $ binds ds -- | Hoist a set of declarations to a binding group. binds :: [Decl] -> Binds binds = BDecls -- | An empty binding group. noBinds :: Binds noBinds = binds [] -- | The wildcard pattern: @_@ wildcard :: Pat wildcard = PWildCard -- | Generate k names by appending numbers 1 through k to a given string. genNames :: String -> Int -> [Name] genNames s k = [ Ident $ s ++ show i | i <- [1..k] ] ------------------------------------------------------------------------------- -- Some more specialised help functions -- | A function with a single clause sfun :: SrcLoc -> Name -> [Name] -> Rhs -> Binds -> Decl sfun s f pvs rhs bs = FunBind [Match s f (map pvar pvs) Nothing rhs bs] -- | A function with a single clause, a single argument, no guards -- and no where declarations simpleFun :: SrcLoc -> Name -> Name -> Exp -> Decl simpleFun s f a e = let rhs = UnGuardedRhs e in sfun s f [a] rhs noBinds -- | A pattern bind where the pattern is a variable, and where -- there are no guards and no 'where' clause. patBind :: SrcLoc -> Pat -> Exp -> Decl patBind s p e = let rhs = UnGuardedRhs e in PatBind s p Nothing rhs noBinds -- | A pattern bind where the pattern is a variable, and where -- there are no guards, but with a 'where' clause. patBindWhere :: SrcLoc -> Pat -> Exp -> [Decl] -> Decl patBindWhere s p e ds = let rhs = UnGuardedRhs e in PatBind s p Nothing rhs (binds ds) -- | Bind an identifier to an expression. nameBind :: SrcLoc -> Name -> Exp -> Decl nameBind s n e = patBind s (pvar n) e -- | Apply function of a given name to a list of arguments. metaFunction :: String -> [Exp] -> Exp metaFunction s es = mf s (reverse es) where mf s [] = var $ name s mf s (e:es) = app (mf s es) e -- | Apply a constructor of a given name to a list of pattern -- arguments, forming a constructor pattern. metaConPat :: String -> [Pat] -> Pat metaConPat s ps = pApp (name s) ps haskell-src-exts-1.14.0/src/Language/Haskell/Exts/InternalParser.ly0000644000000000000000000027153112204617765023316 0ustar0000000000000000> { > {-# OPTIONS_HADDOCK hide #-} > ----------------------------------------------------------------------------- > -- | > -- Module : Language.Haskell.Exts.Annotated.Parser > -- Copyright : (c) Niklas Broberg 2004-2009, > -- Original (c) Simon Marlow, Sven Panne 1997-2000 > -- License : BSD-style (see the file LICENSE.txt) > -- > -- Maintainer : Niklas Broberg, d00nibro@chalmers.se > -- Stability : stable > -- Portability : portable > -- > -- > ----------------------------------------------------------------------------- > > module Language.Haskell.Exts.InternalParser ( > -- * General parsing > ParseMode(..), defaultParseMode, ParseResult(..), fromParseResult, > -- * Parsing of specific AST elements > -- ** Modules > parseModule, parseModuleWithMode, parseModuleWithComments, > -- ** Expressions > parseExp, parseExpWithMode, parseExpWithComments, > -- ** Statements > parseStmt, parseStmtWithMode, parseStmtWithComments, > -- ** Patterns > parsePat, parsePatWithMode, parsePatWithComments, > -- ** Declarations > parseDecl, parseDeclWithMode, parseDeclWithComments, > -- ** Types > parseType, parseTypeWithMode, parseTypeWithComments, > -- ** Multiple modules in one file > parseModules, parseModulesWithMode, parseModulesWithComments, > -- ** Option pragmas > getTopPragmas > ) where > > import Language.Haskell.Exts.Annotated.Syntax hiding ( Type(..), Exp(..), Asst(..), XAttr(..), FieldUpdate(..) ) > import Language.Haskell.Exts.Annotated.Syntax ( Type, Exp, Asst ) > import Language.Haskell.Exts.ParseMonad > import Language.Haskell.Exts.InternalLexer > import Language.Haskell.Exts.ParseUtils > import Language.Haskell.Exts.Annotated.Fixity > import Language.Haskell.Exts.SrcLoc > import Language.Haskell.Exts.Comments ( Comment ) > import Language.Haskell.Exts.Extension > import Control.Monad ( liftM, (<=<) ) import Debug.Trace (trace) > } ----------------------------------------------------------------------------- This module comprises a parser for Haskell 98 with the following extensions * Multi-parameter type classes with functional dependencies * Implicit parameters * Pattern guards * Mdo notation * FFI * HaRP * HSP Most of the code is blatantly stolen from the GHC module Language.Haskell.Parser. Some of the code for extensions is greatly influenced by GHC's internal parser library, ghc/compiler/parser/Parser.y. ----------------------------------------------------------------------------- Conflicts: 7 shift/reduce 2 for ambiguity in 'case x of y | let z = y in z :: Bool -> b' [State 99, 186] (don't know whether to reduce 'Bool' as a btype or shift the '->'. Similarly lambda and if. The default resolution in favour of the shift means that a guard can never end with a type signature. In mitigation: it's a rare case and no Haskell implementation allows these, because it would require unbounded lookahead.) There are 2 conflicts rather than one because contexts are parsed as btypes (cf ctype). 1 for ambiguity in 'let ?x ...' [State 604] the parser can't tell whether the ?x is the lhs of a normal binding or an implicit binding. Fortunately resolving as shift gives it the only sensible meaning, namely the lhs of an implicit binding. 1 for ambiguity using hybrid modules [State 159] For HSP pages that start with a <% %> block, the parser cannot tell whether to reduce a srcloc or shift the starting <%. Since any other body could not start with <%, shifting is the only sensible thing to do. 1 for ambiguity using toplevel xml modules [State 158] For HSP xml pages starting with a <, the parser cannot tell whether to shift that < or reduce an implicit 'open'. Since no other body could possibly start with <, shifting is the only sensible thing to do. 1 for ambiguity in '{-# RULES "name" [ ... #-}' [State 177] we don't know whether the '[' starts the activation or not: it might be the start of the declaration with the activation being empty. Resolving with shift means the declaration cannot start with '['. 1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 544] since 'forall' is a valid variable name, we don't know whether to treat a forall on the input as the beginning of a quantifier or the beginning of the rule itself. Resolving to shift means it's always treated as a quantifier, hence the above is disallowed. This saves explicitly defining a grammar for the rule lhs that doesn't include 'forall'. ----------------------------------------------------------------------------- > %token > VARID { Loc _ (VarId _) } > QVARID { Loc _ (QVarId _) } > IDUPID { Loc _ (IDupVarId _) } -- duplicable implicit parameter ?x > ILINID { Loc _ (ILinVarId _) } -- linear implicit parameter %x > CONID { Loc _ (ConId _) } > QCONID { Loc _ (QConId _) } > DVARID { Loc _ (DVarId _) } -- VARID containing dashes > VARSYM { Loc _ (VarSym _) } > CONSYM { Loc _ (ConSym _) } > QVARSYM { Loc _ (QVarSym _) } > QCONSYM { Loc _ (QConSym _) } > INT { Loc _ (IntTok _) } > RATIONAL { Loc _ (FloatTok _) } > CHAR { Loc _ (Character _) } > STRING { Loc _ (StringTok _) } > PRIMINT { Loc _ (IntTokHash _) } > PRIMWORD { Loc _ (WordTokHash _) } > PRIMFLOAT { Loc _ (FloatTokHash _) } > PRIMDOUBLE { Loc _ (DoubleTokHash _) } > PRIMCHAR { Loc _ (CharacterHash _) } > PRIMSTRING { Loc _ (StringHash _) } Symbols > '(' { Loc $$ LeftParen } > ')' { Loc $$ RightParen } > '(#' { Loc $$ LeftHashParen } > '#)' { Loc $$ RightHashParen } > '{|' { Loc $$ LeftCurlyBar } > '|}' { Loc $$ RightCurlyBar } > ';' { Loc $$ SemiColon } > '{' { Loc $$ LeftCurly } > '}' { Loc $$ RightCurly } > vccurly { Loc $$ VRightCurly } -- a virtual close brace > '[' { Loc $$ LeftSquare } > ']' { Loc $$ RightSquare } > ',' { Loc $$ Comma } > '_' { Loc $$ Underscore } > '`' { Loc $$ BackQuote } Reserved operators > '.' { Loc $$ Dot } > '..' { Loc $$ DotDot } > ':' { Loc $$ Colon } > '::' { Loc $$ DoubleColon } > '=' { Loc $$ Equals } > '\\' { Loc $$ Backslash } > '|' { Loc $$ Bar } > '<-' { Loc $$ LeftArrow } > '->' { Loc $$ RightArrow } > '@' { Loc $$ At } > '~' { Loc $$ Tilde } > '=>' { Loc $$ DoubleArrow } > '-' { Loc $$ Minus } > '!' { Loc $$ Exclamation } > '*' { Loc $$ Star } Arrows > '-<' { Loc $$ LeftArrowTail } > '>-' { Loc $$ RightArrowTail } > '-<<' { Loc $$ LeftDblArrowTail } > '>>-' { Loc $$ RightDblArrowTail } Harp > '(|' { Loc $$ RPGuardOpen } > '|)' { Loc $$ RPGuardClose } > '@:' { Loc $$ RPCAt } Template Haskell > IDSPLICE { Loc _ (THIdEscape _) } -- $x > '$(' { Loc $$ THParenEscape } > '[|' { Loc $$ THExpQuote } > '[p|' { Loc $$ THPatQuote } > '[t|' { Loc $$ THTypQuote } > '[d|' { Loc $$ THDecQuote } > '|]' { Loc $$ THCloseQuote } > VARQUOTE { Loc $$ THVarQuote } -- 'x > TYPQUOTE { Loc $$ THTyQuote } -- ''T > QUASIQUOTE { Loc _ (THQuasiQuote _) } Hsx > PCDATA { Loc _ (XPCDATA _) } > '<' { Loc $$ XStdTagOpen } > ' '<%' { Loc $$ XCodeTagOpen } > '<%>' { Loc $$ XChildTagOpen } > '>' { Loc $$ XStdTagClose } > '/>' { Loc $$ XEmptyTagClose } > '%>' { Loc $$ XCodeTagClose } > '<[' { Loc $$ XRPatOpen } > ']>' { Loc $$ XRPatClose } FFI > 'foreign' { Loc $$ KW_Foreign } > 'export' { Loc $$ KW_Export } > 'safe' { Loc $$ KW_Safe } > 'unsafe' { Loc $$ KW_Unsafe } > 'threadsafe' { Loc $$ KW_Threadsafe } > 'interruptible' { Loc $$ KW_Interruptible } > 'stdcall' { Loc $$ KW_StdCall } > 'ccall' { Loc $$ KW_CCall } > 'cplusplus' { Loc $$ KW_CPlusPlus } > 'dotnet' { Loc $$ KW_DotNet } > 'jvm' { Loc $$ KW_Jvm } > 'js' { Loc $$ KW_Js } > 'capi' { Loc $$ KW_CApi } Reserved Ids > 'as' { Loc $$ KW_As } > 'by' { Loc $$ KW_By } -- transform list comprehensions > 'case' { Loc $$ KW_Case } > 'class' { Loc $$ KW_Class } > 'data' { Loc $$ KW_Data } > 'default' { Loc $$ KW_Default } > 'deriving' { Loc $$ KW_Deriving } > 'do' { Loc $$ KW_Do } > 'else' { Loc $$ KW_Else } > 'family' { Loc $$ KW_Family } -- indexed type families > 'forall' { Loc $$ KW_Forall } -- universal/existential qualification > 'group' { Loc $$ KW_Group } -- transform list comprehensions > 'hiding' { Loc $$ KW_Hiding } > 'if' { Loc $$ KW_If } > 'import' { Loc $$ KW_Import } > 'in' { Loc $$ KW_In } > 'infix' { Loc $$ KW_Infix } > 'infixl' { Loc $$ KW_InfixL } > 'infixr' { Loc $$ KW_InfixR } > 'instance' { Loc $$ KW_Instance } > 'let' { Loc $$ KW_Let } > 'mdo' { Loc $$ KW_MDo } > 'module' { Loc $$ KW_Module } > 'newtype' { Loc $$ KW_NewType } > 'of' { Loc $$ KW_Of } > 'proc' { Loc $$ KW_Proc } -- arrows > 'rec' { Loc $$ KW_Rec } -- arrows > 'then' { Loc $$ KW_Then } > 'type' { Loc $$ KW_Type } > 'using' { Loc $$ KW_Using } -- transform list comprehensions > 'where' { Loc $$ KW_Where } > 'qualified' { Loc $$ KW_Qualified } Pragmas > '{-# INLINE' { Loc _ (INLINE _) } > '{-# INLINE_CONLIKE' { Loc $$ INLINE_CONLIKE } > '{-# SPECIALISE' { Loc $$ SPECIALISE } > '{-# SPECIALISE_INLINE' { Loc _ (SPECIALISE_INLINE _) } > '{-# SOURCE' { Loc $$ SOURCE } > '{-# RULES' { Loc $$ RULES } > '{-# CORE' { Loc $$ CORE } > '{-# SCC' { Loc $$ SCC } > '{-# GENERATED' { Loc $$ GENERATED } > '{-# DEPRECATED' { Loc $$ DEPRECATED } > '{-# WARNING' { Loc $$ WARNING } > '{-# UNPACK' { Loc $$ UNPACK } > '{-# OPTIONS' { Loc _ (OPTIONS _) } '{-# CFILES' { Loc _ (CFILES _) } '{-# INCLUDE' { Loc _ (INCLUDE _) } > '{-# LANGUAGE' { Loc $$ LANGUAGE } > '{-# ANN' { Loc $$ ANN } > '#-}' { Loc $$ PragmaEnd } > %monad { P } > %lexer { lexer } { Loc _ EOF } > %error { parseError } > %name mparseModule page > %name mparseExp trueexp > %name mparsePat pat > %name mparseDecl topdecl > %name mparseType truectype > %name mparseStmt stmt > %name mparseModules modules > %partial mfindOptPragmas toppragmas > %tokentype { Loc Token } > %expect 7 > %% ----------------------------------------------------------------------------- Testing multiple modules in one file > modules :: { [Module L] } > : toppragmas modules1 { let (os,ss,l) = $1 in map (\x -> x os ss l) $2 } > modules1 :: { [[ModulePragma L] -> [S] -> L -> Module L] } > : module modules1 { $1 : $2 } > | module { [$1] } ----------------------------------------------------------------------------- HSP Pages Any HSP-specific parts requiring the XmlSyntax extension enabled will be governed by the lexing, since all productions require at least one special lexeme. TODO: Yuck, this is messy, needs fixing in the AST! > page :: { Module L } > : toppragmas topxml {% checkPageModule $2 $1 } > | toppragmas '<%' module '%>' topxml {% let (os,ss,l) = $1 in checkHybridModule $5 ($3 os ss l) $2 $4 } > | toppragmas module { let (os,ss,l) = $1 in $2 os ss l } > topxml :: { PExp L } > : '<' name attrs mattr '>' children '' {% do { n <- checkEqNames $2 $8; > let { cn = reverse $6; > as = reverse $3; }; > return $ XTag ($1 <^^> $9 <** [$1,$5,$7,$9]) n as $4 cn } } > | '<' name attrs mattr '/>' { XETag ($1 <^^> $5 <** [$1,$5]) $2 (reverse $3) $4 } > toppragmas :: { ([ModulePragma L],[S],L) } > : open toppragmasaux close { let (os,ss,ml) = $2 in (os,$1:ss++[$3],$1 <^^> $3) } > toppragmasaux :: { ([ModulePragma L],[S],Maybe L) } > : toppragma ';' toppragmasaux { let (os,ss,ml) = $3 in ($1 : os, $2 : ss, Just $ ann $1 <++> nIS $2 <+?> ml) } > | {- nothing -} { ([],[],Nothing) } > toppragma :: { ModulePragma L } > : '{-# LANGUAGE' conids optsemis '#-}' { LanguagePragma ($1 <^^> $4 <** ($1:snd $2 ++ reverse $3 ++ [$4])) (fst $2) } > | '{-# OPTIONS' optsemis '#-}' { let Loc l (OPTIONS (mc, s)) = $1 > in OptionsPragma (l <^^> $3 <** (l:reverse $2 ++ [$3])) (readTool mc) s } > | '{-# ANN' annotation '#-}' { AnnModulePragma ($1 <^^> $3 <** [$1,$3]) $2 } > conids :: { ([Name L],[S]) } > : conid ',' conids { ($1 : fst $3, $2 : snd $3) } > | conid { ([$1],[]) } ----------------------------------------------------------------------------- Module Header > module :: { [ModulePragma L] -> [S] -> L -> Module L } > : optmodulehead body > { let (is,ds,ss1,inf) = $2 > in \os ss l -> Module (l <++> inf <** (ss ++ ss1)) $1 os is ds } > optmodulehead :: { Maybe (ModuleHead L) } > : 'module' modid maybemodwarning maybeexports 'where' { Just $ ModuleHead ($1 <^^> $5 <** [$1,$5]) $2 $3 $4 } > | {- empty -} { Nothing } > maybemodwarning :: { Maybe (WarningText L) } > : '{-# DEPRECATED' STRING '#-}' { let Loc l (StringTok (s,_)) = $2 in Just $ DeprText ($1 <^^> $3 <** [$1,l,$3]) s } > | '{-# WARNING' STRING '#-}' { let Loc l (StringTok (s,_)) = $2 in Just $ WarnText ($1 <^^> $3 <** [$1,l,$3]) s } > | {- empty -} { Nothing } > body :: { ([ImportDecl L],[Decl L],[S],L) } > : '{' bodyaux '}' { let (is,ds,ss) = $2 in (is,ds,$1:ss ++ [$3], $1 <^^> $3) } > | open bodyaux close { let (is,ds,ss) = $2 in (is,ds,$1:ss ++ [$3], $1 <^^> $3) } > bodyaux :: { ([ImportDecl L],[Decl L],[S]) } > : optsemis impdecls semis topdecls { (reverse (fst $2), fst $4, reverse $1 ++ snd $2 ++ reverse $3 ++ snd $4) } > | optsemis topdecls { ([], fst $2, reverse $1 ++ snd $2) } > | optsemis impdecls optsemis { (reverse (fst $2), [], reverse $1 ++ snd $2 ++ reverse $3) } > | optsemis { ([], [], reverse $1) } > semis :: { [S] } > : optsemis ';' { $2 : $1 } > optsemis :: { [S] } > : semis { $1 } > | {- empty -} { [] } ----------------------------------------------------------------------------- The Export List > maybeexports :: { Maybe (ExportSpecList L) } > : exports { Just $1 } > | {- empty -} { Nothing } > exports :: { ExportSpecList L } > : '(' exportlist optcomma ')' { ExportSpecList ($1 <^^> $4 <** ($1:reverse (snd $2) ++ $3 ++ [$4])) (reverse (fst $2)) } > | '(' optcomma ')' { ExportSpecList ($1 <^^> $3 <** ($1:$2++[$3])) [] } > optcomma :: { [S] } > : ',' { [$1] } > | {- empty -} { [ ] } > exportlist :: { ([ExportSpec L],[S]) } > : exportlist ',' export { ($3 : fst $1, $2 : snd $1) } > | export { ([$1],[]) } > export :: { ExportSpec L } > : qvar { EVar (ann $1) $1 } > | qtyconorcls { EAbs (ann $1) $1 } > | qtyconorcls '(' '..' ')' { EThingAll (ann $1 <++> nIS $4 <** [$2,$3,$4]) $1 } > | qtyconorcls '(' ')' { EThingWith (ann $1 <++> nIS $3 <** [$2,$3]) $1 [] } > | qtyconorcls '(' cnames ')' { EThingWith (ann $1 <++> nIS $4 <** ($2:reverse (snd $3) ++ [$4])) $1 (reverse (fst $3)) } > | 'module' modid { EModuleContents (nIS $1 <++> ann $2 <** [$1]) $2 } ----------------------------------------------------------------------------- Import Declarations > impdecls :: { ([ImportDecl L],[S]) } > : impdecls semis impdecl { ($3 : fst $1, snd $1 ++ reverse $2) } > | impdecl { ([$1],[]) } > impdecl :: { ImportDecl L } > : 'import' optsrc optqualified maybepkg modid maybeas maybeimpspec > { let { (mmn,ss,ml) = $6 ; > l = nIS $1 <++> ann $5 <+?> ml <+?> (fmap ann) $7 <** ($1:snd $2 ++ snd $3 ++ snd $4 ++ ss)} > in ImportDecl l $5 (fst $3) (fst $2) (fst $4) mmn $7 } > optsrc :: { (Bool,[S]) } > : '{-# SOURCE' '#-}' { (True,[$1,$2]) } > | {- empty -} { (False,[]) } > optqualified :: { (Bool,[S]) } > : 'qualified' { (True,[$1]) } > | {- empty -} { (False, []) } Requires the PackageImports extension enabled. > maybepkg :: { (Maybe String,[S]) } > : STRING {% do { checkEnabled PackageImports ; > let { Loc l (StringTok (s,_)) = $1 } ; > return $ (Just s,[l]) } } > | {- empty -} { (Nothing,[]) } > maybeas :: { (Maybe (ModuleName L),[S],Maybe L) } > : 'as' modid { (Just $2,[$1],Just (nIS $1 <++> ann $2)) } > | {- empty -} { (Nothing,[],Nothing) } > maybeimpspec :: { Maybe (ImportSpecList L) } > : impspec { Just $1 } > | {- empty -} { Nothing } > impspec :: { ImportSpecList L } > : opthiding '(' importlist optcomma ')' { let {(b,ml,s) = $1 ; > l = (ml ($2 <^^> $5)) <** (s ++ $2:reverse (snd $3) ++ $4 ++ [$5])} > in ImportSpecList l b (reverse (fst $3)) } > | opthiding '(' optcomma ')' { let {(b,ml,s) = $1 ; l = (ml ($2 <^^> $4)) <** (s ++ $2:$3 ++ [$4])} > in ImportSpecList l b [] } > opthiding :: { (Bool, Maybe L,[S]) } > : 'hiding' { (True,Just (nIS $1),[$1]) } > | {- empty -} { (False,Nothing,[]) } > importlist :: { ([ImportSpec L],[S]) } > : importlist ',' importspec { ($3 : fst $1, $2 : snd $1) } > | importspec { ([$1],[]) } > importspec :: { ImportSpec L } > : var { IVar (ann $1) $1 } > | tyconorcls { IAbs (ann $1) $1 } > | tyconorcls '(' '..' ')' { IThingAll (ann $1 <++> nIS $4 <** [$2,$3,$4]) $1 } > | tyconorcls '(' ')' { IThingWith (ann $1 <++> nIS $3 <** [$2,$3]) $1 [] } > | tyconorcls '(' cnames ')' { IThingWith (ann $1 <++> nIS $4 <** ($2:reverse (snd $3) ++ [$4])) $1 (reverse (fst $3)) } > cnames :: { ([CName L],[S]) } > : cnames ',' cname { ($3 : fst $1, $2 : snd $1) } > | cname { ([$1],[]) } > cname :: { CName L } > : var { VarName (ann $1) $1 } > | con { ConName (ann $1) $1 } ----------------------------------------------------------------------------- Fixity Declarations > fixdecl :: { Decl L } > : infix prec ops { let (ops,ss,l) = $3 > in InfixDecl (ann $1 <++> l <** (snd $2 ++ reverse ss)) $1 (fst $2) (reverse ops) } > prec :: { (Maybe Int, [S]) } > : {- empty -} { (Nothing, []) } > | INT {% let Loc l (IntTok (i,_)) = $1 in checkPrec i >>= \i -> return (Just i, [l]) } > infix :: { Assoc L } > : 'infix' { AssocNone $ nIS $1 } > | 'infixl' { AssocLeft $ nIS $1 } > | 'infixr' { AssocRight $ nIS $1 } > ops :: { ([Op L],[S],L) } > : ops ',' op { let (ops,ss,l) = $1 in ($3 : ops, $2 : ss, l <++> ann $3) } > | op { ([$1],[],ann $1) } ----------------------------------------------------------------------------- Top-Level Declarations Note: The report allows topdecls to be empty. This would result in another shift/reduce-conflict, so we don't handle this case here, but in bodyaux. > topdecls :: { ([Decl L],[S]) } > : topdecls1 optsemis {% checkRevDecls (fst $1) >>= \ds -> return (ds, snd $1 ++ reverse $2) } > topdecls1 :: { ([Decl L],[S]) } > : topdecls1 semis topdecl { ($3 : fst $1, snd $1 ++ reverse $2) } > | topdecl { ([$1],[]) } > topdecl :: { Decl L } > : 'type' dtype '=' truectype > {% do { dh <- checkSimpleType $2; > let {l = nIS $1 <++> ann $4 <** [$1,$3]}; > return (TypeDecl l dh $4) } } Requires the TypeFamilies extension enabled, but the lexer will handle that through the 'family' keyword. > | 'type' 'family' type optkind > {% do { dh <- checkSimpleType $3; > let {l = nIS $1 <++> ann $3 <+?> (fmap ann) (fst $4) <** ($1:$2:snd $4)}; > return (TypeFamDecl l dh (fst $4)) } } Here there is no special keyword so we must do the check. > | 'type' 'instance' truedtype '=' truectype > {% do { -- no checkSimpleType $4 since dtype may contain type patterns > checkEnabled TypeFamilies ; > let {l = nIS $1 <++> ann $5 <** [$1,$2,$4]}; > return (TypeInsDecl l $3 $5) } } > | data_or_newtype ctype constrs0 deriving > {% do { (cs,dh) <- checkDataHeader $2; > let { (qds,ss,minf) = $3; > l = $1 <> $2 <+?> minf <+?> fmap ann $4 <** ss}; > checkDataOrNew $1 qds; > return (DataDecl l $1 cs dh (reverse qds) $4) } } Requires the GADTs extension enabled, handled in gadtlist. > | data_or_newtype ctype optkind gadtlist deriving > {% do { (cs,dh) <- checkDataHeader $2; > let { (gs,ss,minf) = $4; > l = ann $1 <+?> minf <+?> fmap ann $5 <** (snd $3 ++ ss)}; > checkDataOrNewG $1 gs; > case (gs, fst $3) of > ([], Nothing) -> return (DataDecl l $1 cs dh [] $5) > _ -> checkEnabled GADTs >> return (GDataDecl l $1 cs dh (fst $3) (reverse gs) $5) } } Same as above, lexer will handle it through the 'family' keyword. > | 'data' 'family' ctype optkind > {% do { (cs,dh) <- checkDataHeader $3; > let {l = nIS $1 <++> ann $3 <+?> (fmap ann) (fst $4) <** ($1:$2:snd $4)}; > return (DataFamDecl l cs dh (fst $4)) } } Here we must check for TypeFamilies. > | data_or_newtype 'instance' truectype constrs0 deriving > {% do { -- (cs,c,t) <- checkDataHeader $4; > checkEnabled TypeFamilies ; > let { (qds,ss,minf) = $4 ; > l = $1 <> $3 <+?> minf <+?> fmap ann $5 <** $2:ss }; > checkDataOrNew $1 qds; > return (DataInsDecl l $1 $3 (reverse qds) $5) } } This style requires both TypeFamilies and GADTs, the latter is handled in gadtlist. > | data_or_newtype 'instance' truectype optkind gadtlist deriving > {% do { -- (cs,c,t) <- checkDataHeader $4; > checkEnabled TypeFamilies ; > let {(gs,ss,minf) = $5; > l = ann $1 <+?> minf <+?> fmap ann $6 <** ($2:snd $4 ++ ss)}; > checkDataOrNewG $1 gs; > return (GDataInsDecl l $1 $3 (fst $4) (reverse gs) $6) } } > | 'class' ctype fds optcbody > {% do { (cs,dh) <- checkClassHeader $2; > let {(fds,ss1,minf1) = $3;(mcs,ss2,minf2) = $4} ; > let { l = nIS $1 <++> ann $2 <+?> minf1 <+?> minf2 <** ($1:ss1 ++ ss2)} ; > return (ClassDecl l cs dh fds mcs) } } > | 'instance' ctype optvaldefs > {% do { (cs,ih) <- checkInstHeader $2; > let {(mis,ss,minf) = $3}; > return (InstDecl (nIS $1 <++> ann $2 <+?> minf <** ($1:ss)) cs ih mis) } } Requires the StandaloneDeriving extension enabled. > | 'deriving' 'instance' ctype > {% do { checkEnabled StandaloneDeriving ; > (cs, ih) <- checkInstHeader $3; > let {l = nIS $1 <++> ann $3 <** [$1,$2]}; > return (DerivDecl l cs ih) } } > | 'default' '(' typelist ')' > { DefaultDecl ($1 <^^> $4 <** ($1:$2 : snd $3 ++ [$4])) (fst $3) } Requires the TemplateHaskell extension, but the lexer will handle that through the '$(' lexeme. CHANGE: Arbitrary top-level expressions are considered implicit splices > | exp0 {% checkEnabled TemplateHaskell >> checkExpr $1 >>= \e -> return (SpliceDecl (ann e) e) } | '$(' trueexp ')' { let l = $1 <^^> $3 <** [$1,$3] in SpliceDecl l $ ParenSplice l $2 } These require the ForeignFunctionInterface extension, handled by the lexer through the 'foreign' (and 'export') keyword. > | 'foreign' 'import' callconv safety fspec > { let (s,n,t,ss) = $5 in ForImp (nIS $1 <++> ann t <** ($1:$2:ss)) $3 $4 s n t } > | 'foreign' 'export' callconv fspec > { let (s,n,t,ss) = $4 in ForExp (nIS $1 <++> ann t <** ($1:$2:ss)) $3 s n t } > | '{-# RULES' rules '#-}' { RulePragmaDecl ($1 <^^> $3 <** [$1,$3]) $ reverse $2 } > | '{-# DEPRECATED' warndeprs '#-}' { DeprPragmaDecl ($1 <^^> $3 <** ($1:snd $2++[$3])) $ reverse (fst $2) } > | '{-# WARNING' warndeprs '#-}' { WarnPragmaDecl ($1 <^^> $3 <** ($1:snd $2++[$3])) $ reverse (fst $2) } > | '{-# ANN' annotation '#-}' { AnnPragma ($1 <^^> $3 <** [$1,$3]) $2 } > | decl { $1 } > data_or_newtype :: { DataOrNew L } > : 'data' { DataType $ nIS $1 } > | 'newtype' { NewType $ nIS $1 } > typelist :: { ([Type L],[S]) } > : types {% do { ts <- mapM checkType (fst $1); > return $ (reverse ts, reverse (snd $1)) } } > | truetype { ([$1],[]) } > | {- empty -} { ([],[]) } > decls :: { ([Decl L],[S]) } > : optsemis decls1 optsemis {% checkRevDecls (fst $2) >>= \ds -> return (ds, reverse $1 ++ snd $2 ++ reverse $3) } > | optsemis { ([],reverse $1) } > decls1 :: { ([Decl L],[S]) } > : decls1 semis decl { ($3 : fst $1, snd $1 ++ reverse $2) } > | decl { ([$1],[]) } > decl :: { Decl L } > : signdecl { $1 } > | fixdecl { $1 } > | valdef { $1 } > decllist :: { Binds L } > : '{' decls '}' { BDecls ($1 <^^> $3 <** ($1:snd $2++[$3])) (fst $2) } > | open decls close { BDecls ($1 <^^> $3 <** ($1:snd $2++[$3])) (fst $2) } > signdecl :: { Decl L } > : exp0b '::' truectype {% do { v <- checkSigVar $1; > return $ TypeSig ($1 <> $3 <** [$2]) [v] $3 } } > | exp0b ',' vars '::' truectype {% do { v <- checkSigVar $1; > let {(vs,ss,_) = $3 ; l = $1 <> $5 <** ($2 : reverse ss ++ [$4]) } ; > return $ TypeSig l (v : reverse vs) $5 } } > | specinldecl { $1 } > specinldecl :: { Decl L } > : '{-# INLINE' activation qvar '#-}' { let Loc l (INLINE s) = $1 in InlineSig (l <^^> $4 <** [l,$4]) s $2 $3 } > | '{-# INLINE_CONLIKE' activation qvar '#-}' { InlineConlikeSig ($1 <^^> $4 <** [$1,$4]) $2 $3 } > | '{-# SPECIALISE' activation qvar '::' sigtypes '#-}' > { SpecSig ($1 <^^> $6 <** ($1: $4 : snd $5 ++ [$6])) $2 $3 (fst $5) } > | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes '#-}' > { let Loc l (SPECIALISE_INLINE s) = $1 > in SpecInlineSig (l <^^> $6 <** (l:$4:snd $5++[$6])) s $2 $3 (fst $5) } > | '{-# SPECIALISE' 'instance' ctype '#-}' {% do { (cs,ih) <- checkInstHeader $3; > let {l = $1 <^^> $4 <** [$1,$2,$4]}; > return $ InstSig l cs ih } } > sigtypes :: { ([Type L],[S]) } > : sigtype { ([$1],[]) } > | sigtype ',' sigtypes { ($1 : fst $3, $2 : snd $3) } > sigtype :: { Type L } > : ctype {% checkType $ mkTyForall (ann $1) Nothing Nothing $1 } Binding can be either of implicit parameters, or it can be a normal sequence of declarations. The two kinds cannot be mixed within the same block of binding. > binds :: { Binds L } > : decllist { $1 } > | '{' ipbinds '}' { IPBinds ($1 <^^> $3 <** snd $2) (fst $2) } > | open ipbinds close { IPBinds ($1 <^^> $3 <** snd $2) (fst $2) } ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var instead of qvar, we get another shift/reduce-conflict. Consider the following programs: { (+) :: ... } only var { (+) x y = ... } could (incorrectly) be qvar We re-use expressions for patterns, so a qvar would be allowed in patterns instead of a var only (which would be correct). But deciding what the + is, would require more lookahead. So let's check for ourselves... > vars :: { ([Name L],[S],L) } > : vars ',' var { let (ns,ss,l) = $1 in ($3 : ns, $2 : ss, l <++> ann $3) } > | qvar {% do { n <- checkUnQual $1; > return ([n],[],ann n) } } ----------------------------------------------------------------------------- FFI These will only be called on in the presence of a 'foreign' keyword, so no need to check for extensions. > callconv :: { CallConv L } > : 'stdcall' { StdCall (nIS $1) } > | 'ccall' { CCall (nIS $1) } > | 'cplusplus' { CPlusPlus (nIS $1) } > | 'dotnet' { DotNet (nIS $1) } > | 'jvm' { Jvm (nIS $1) } > | 'js' { Js (nIS $1) } > | 'capi' { CApi (nIS $1) } > safety :: { Maybe (Safety L) } > : 'safe' { Just $ PlaySafe (nIS $1) False } > | 'unsafe' { Just $ PlayRisky (nIS $1) } > | 'threadsafe' { Just $ PlaySafe (nIS $1) True } > | 'interruptible' { Just $ PlayInterruptible (nIS $1) } > | {- empty -} { Nothing } > fspec :: { (Maybe String, Name L, Type L, [S]) } > : STRING var_no_safety '::' truedtype { let Loc l (StringTok (s,_)) = $1 in (Just s, $2, $4, [l,$3]) } > | var_no_safety '::' truedtype { (Nothing, $1, $3, [$2]) } ----------------------------------------------------------------------------- Pragmas > rules :: { [Rule L] } > : rules ';'rule { $3 : $1 } > | rules ';' { $1 } > | rule { [$1] } > | {- empty -} { [] } > rule :: { Rule L } > : STRING activation ruleforall exp0 '=' trueexp {% do { let {Loc l (StringTok (s,_)) = $1}; > e <- checkRuleExpr $4; > return $ Rule (nIS l <++> ann $6 <** l:snd $3 ++ [$5]) s $2 (fst $3) e $6 } } > activation :: { Maybe (Activation L) } > : {- empty -} { Nothing } > | '[' INT ']' { let Loc l (IntTok (i,_)) = $2 in Just $ ActiveFrom ($1 <^^> $3 <** [$1,l,$3]) (fromInteger i) } > | '[' '~' INT ']' { let Loc l (IntTok (i,_)) = $3 in Just $ ActiveUntil ($1 <^^> $4 <** [$1,$2,l,$4]) (fromInteger i) } > ruleforall :: { (Maybe [RuleVar L],[S]) } > : {- empty -} { (Nothing,[]) } > | 'forall' rulevars '.' { (Just $2,[$1,$3]) } > rulevars :: { [RuleVar L] } > : rulevar { [$1] } > | rulevar rulevars { $1 : $2 } > rulevar :: { RuleVar L } > : varid { RuleVar (ann $1) $1 } > | '(' varid '::' truectype ')' { TypedRuleVar ($1 <^^> $5 <** [$1,$3,$5]) $2 $4 } > warndeprs :: { ([([Name L],String)],[S]) } > : warndeprs ';' warndepr { (fst $3 : fst $1, snd $1 ++ ($2:snd $3)) } > | warndeprs ';' { (fst $1, snd $1 ++ [$2]) } > | warndepr { ([fst $1],snd $1) } > | {- empty -} { ([],[]) } > warndepr :: { (([Name L], String),[S]) } > : namevars STRING { let Loc l (StringTok (s,_)) = $2 in ((fst $1,s),snd $1 ++ [l]) } > namevars :: { ([Name L],[S]) } > : namevar { ([$1],[]) } > | namevar ',' namevars { ($1 : fst $3, $2 : snd $3) } > namevar :: { Name L } > : con { $1 } > | var { $1 } > annotation :: { Annotation L } > : 'type' conid aexp {% checkExpr $3 >>= \e -> return (TypeAnn (nIS $1 <++> ann e <** [$1]) $2 e) } > | 'module' aexp {% checkExpr $2 >>= \e -> return (ModuleAnn (nIS $1 <++> ann e <** [$1]) e) } > | namevar aexp {% checkExpr $2 >>= \e -> return (Ann ($1 <> e) $1 e) } ----------------------------------------------------------------------------- Types Type equality contraints need the TypeFamilies extension. > truedtype :: { Type L } > : dtype {% checkType $1 } > dtype :: { PType L } > : btype { $1 } > | btype qtyconop dtype { TyInfix ($1 <> $3) $1 $2 $3 } > | btype qtyvarop dtype { TyInfix ($1 <> $3) $1 $2 $3 } -- FIXME > | btype '->' ctype { TyFun ($1 <> $3 <** [$2]) $1 $3 } > | btype '~' btype {% do { checkEnabled TypeFamilies ; > let {l = $1 <> $3 <** [$2]}; > return $ TyPred l $ EqualP l $1 $3 } } Implicit parameters can occur in normal types, as well as in contexts. > truetype :: { Type L } > : type {% checkType $1 } > type :: { PType L } > : ivar '::' dtype { let l = ($1 <> $3 <** [$2]) in TyPred l $ IParam l $1 $3 } > | dtype { $1 } > truebtype :: { Type L } > : btype {% checkType $1 } > btype :: { PType L } > : btype atype { TyApp ($1 <> $2) $1 $2 } > | atype { $1 } UnboxedTuples requires the extension, but that will be handled through the (# and #) lexemes. Kinds will be handled at the kind rule. > trueatype :: { Type L } > : atype {% checkType $1 } > atype :: { PType L } > : gtycon { TyCon (ann $1) $1 } > | tyvar { TyVar (ann $1) $1 } > | '(' types ')' { TyTuple ($1 <^^> $3 <** ($1:reverse ($3:snd $2))) Boxed (reverse (fst $2)) } > | '(#' types1 '#)' { TyTuple ($1 <^^> $3 <** ($1:reverse ($3:snd $2))) Unboxed (reverse (fst $2)) } > | '[' type ']' { TyList ($1 <^^> $3 <** [$1,$3]) $2 } > | '(' ctype ')' { TyParen ($1 <^^> $3 <** [$1,$3]) $2 } > | '(' ctype '::' kind ')' { TyKind ($1 <^^> $5 <** [$1,$3,$5]) $2 $4 } > gtycon :: { QName L } > : otycon { $1 } > | '(' ')' { unit_tycon_name ($1 <^^> $2 <** [$1,$2]) } > | '(' '->' ')' { fun_tycon_name ($1 <^^> $3 <** [$1,$2,$3]) } > | '[' ']' { list_tycon_name ($1 <^^> $2 <** [$1,$2]) } > | '(' commas ')' { tuple_tycon_name ($1 <^^> $3 <** ($1:reverse $2 ++ [$3])) Boxed (length $2) } > | '(#' '#)' { unboxed_singleton_tycon_name ($1 <^^> $2 <** [$1,$2]) } > | '(#' commas '#)' { tuple_tycon_name ($1 <^^> $3 <** ($1:reverse $2 ++ [$3])) Unboxed (length $2) } > otycon :: { QName L } > : qconid { $1 } > | '(' gconsym ')' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > | '(' qvarsym ')' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } These are for infix types > qtyconop :: { QName L } > : qconop { $1 } (Slightly edited) Comment from GHC's hsparser.y: "context => type" vs "type" is a problem, because you can't distinguish between foo :: (Baz a, Baz a) bar :: (Baz a, Baz a) => [a] -> [a] -> [a] with one token of lookahead. The HACK is to parse the context as a btype (more specifically as a tuple type), then check that it has the right form C a, or (C1 a, C2 b, ... Cn z) and convert it into a context. Blaach! Forall-quantified types require some extension to enable them, which is any of the keyword-enabling ones, except ExistentialQuantification. > truectype :: { Type L } > : ctype {% checkType $1 } > ctype :: { PType L } > : 'forall' ktyvars '.' ctype { TyForall (nIS $1 <++> ann $4 <** [$1,$3]) (Just (reverse (fst $2))) Nothing $4 } > | context ctype { TyForall ($1 <> $2) Nothing (Just $1) $2 } > | type { $1 } Equality constraints require the TypeFamilies extension. > context :: { PContext L } > : btype '=>' {% checkPContext $ (amap (\l -> l <++> nIS $2 <** (srcInfoPoints l ++ [$2]))) $1 } > | btype '~' btype '=>' {% do { checkEnabled TypeFamilies; > let {l = $1 <> $3 <** [$2,$4]}; > checkPContext (TyPred l $ EqualP l $1 $3) } } > types :: { ([PType L],[S]) } > : types1 ',' ctype { ($3 : fst $1, $2 : snd $1) } > types1 :: { ([PType L],[S]) } > : ctype { ([$1],[]) } > | types1 ',' ctype { ($3 : fst $1, $2 : snd $1) } > ktyvars :: { ([TyVarBind L],Maybe L) } > : ktyvars ktyvar { ($2 : fst $1, Just (snd $1 ann $2)) } > | {- empty -} { ([],Nothing) } > ktyvar :: { TyVarBind L } > : tyvar { UnkindedVar (ann $1) $1 } > | '(' tyvar '::' kind ')' { KindedVar ($1 <^^> $5 <** [$1,$3,$5]) $2 $4 } > tyvars :: { ([Name L],Maybe L) } > : tyvars tyvar { ($2 : fst $1, Just (snd $1 ann $2)) } > | {- empty -} { ([], Nothing) } > tyvars1 :: { ([Name L],L) } > : tyvars tyvar { ($2 : fst $1, snd $1 ann $2) } ----------------------------------------------------------------------------- Functional Dependencies These require the FunctionalDependencies extension to be enabled. > fds :: { ([FunDep L],[S],Maybe L) } > : {- empty -} { ([],[], Nothing) } > | '|' fds1 {% do { checkEnabled FunctionalDependencies ; > let {(fds,ss,l) = $2} ; > return (reverse fds, $1 : reverse ss, Just (nIS $1 <++> l)) } } > fds1 :: { ([FunDep L],[S],L) } > : fds1 ',' fd { let (fds,ss,l) = $1 in ($3 : fds, $2 : ss, l <++> ann $3) } > | fd { ([$1],[],ann $1) } > fd :: { FunDep L } > : tyvars '->' tyvars1 { FunDep (snd $1 nIS $2 <++> snd $3 <** [$2]) (reverse (fst $1)) (reverse (fst $3)) } ----------------------------------------------------------------------------- Datatype declarations GADTs - require the GADTs extension enabled, but we handle that at the calling site. gadtlist :: { ([GadtDecl L],[S],L) } : gadtlist1 {% >> return $1 } > gadtlist :: { ([GadtDecl L],[S],Maybe L) } > : 'where' '{' gadtconstrs1 '}' {% return (fst $3, $1 : $2 : snd $3 ++ [$4], Just $ $1 <^^> $4) } > | 'where' open gadtconstrs1 close {% return (fst $3, $1 : $2 : snd $3 ++ [$4], Just $ $1 <^^> $4) } > | {- empty -} {% checkEnabled EmptyDataDecls >> return ([],[],Nothing) } > gadtconstrs1 :: { ([GadtDecl L],[S]) } > : optsemis gadtconstrs optsemis { (fst $2, reverse $1 ++ snd $2 ++ reverse $3) } > gadtconstrs :: { ([GadtDecl L],[S]) } > : gadtconstrs semis gadtconstr { ($3 : fst $1, snd $1 ++ reverse $2) } > | gadtconstr { ([$1],[]) } > gadtconstr :: { GadtDecl L } > : qcon '::' truectype {% do { c <- checkUnQual $1; > return $ GadtDecl ($1 <> $3 <** [$2]) c $3 } } To allow the empty case we need the EmptyDataDecls extension. > constrs0 :: { ([QualConDecl L],[S],Maybe L) } : {- empty -} {% checkEnabled EmptyDataDecls >> return ([],[],Nothing) } > : '=' constrs { let (ds,ss,l) = $2 in (ds, $1 : reverse ss, Just $ nIS $1 <++> l) } > constrs :: { ([QualConDecl L],[S],L) } > : constrs '|' constr { let (ds,ss,l) = $1 in ($3 : ds, $2 : ss, l <++> ann $3) } > | constr { ([$1],[],ann $1) } > constr :: { QualConDecl L } > : forall context constr1 {% do { checkEnabled ExistentialQuantification ; > ctxt <- checkContext (Just $2) ; > let {(mtvs,ss,ml) = $1} ; > return $ QualConDecl (ml ann $3 <** ss) mtvs ctxt $3 } } > | forall constr1 { let (mtvs, ss, ml) = $1 in QualConDecl (ml ann $2 <** ss) mtvs Nothing $2 } > forall :: { (Maybe [TyVarBind L], [S], Maybe L) } > : 'forall' ktyvars '.' {% checkEnabled ExistentialQuantification >> return (Just (fst $2), [$1,$3], Just $ $1 <^^> $3) } > | {- empty -} { (Nothing, [], Nothing) } To avoid conflicts when introducing type operators, we need to parse record constructors as qcon and then check separately that they are truly unqualified. > constr1 :: { ConDecl L } > : scontype { let (n,ts,l) = $1 in ConDecl l n ts } > | sbtype conop sbtype { InfixConDecl ($1 <> $3) $1 $2 $3 } > | qcon '{' '}' {% do { c <- checkUnQual $1; return $ RecDecl (ann $1 <++> nIS $3 <** [$2,$3]) c [] } } > | qcon '{' fielddecls '}' {% do { c <- checkUnQual $1; > return $ RecDecl (ann $1 <++> nIS $4 <** ($2:reverse (snd $3) ++ [$4])) c (reverse (fst $3)) } } > scontype :: { (Name L, [BangType L], L) } > : btype {% do { (c,ts) <- splitTyConApp $1; > return (c,map (\t -> UnBangedTy (ann t) t) ts,ann $1) } } > | scontype1 { $1 } > scontype1 :: { (Name L, [BangType L],L) } > : btype '!' trueatype {% do { (c,ts) <- splitTyConApp $1; > return (c,map (\t -> UnBangedTy (ann t) t) ts++ > [BangedTy (nIS $2 <++> ann $3 <** [$2]) $3], $1 <> $3) } } > | btype '{-# UNPACK' '#-}' '!' trueatype {% do { (c,ts) <- splitTyConApp $1; > return (c,map (\t -> UnBangedTy (ann t) t) ts++ > [UnpackedTy (nIS $2 <++> ann $5 <** [$2,$3,$4]) $5], $1 <> $5) } } > | scontype1 satype { let (n,ts,l) = $1 in (n, ts ++ [$2],l <++> ann $2) } > satype :: { BangType L } > : trueatype { UnBangedTy (ann $1) $1 } > | '!' trueatype { BangedTy (nIS $1 <++> ann $2 <** [$1]) $2 } > | '{-# UNPACK' '#-}' '!' trueatype { UnpackedTy (nIS $1 <++> ann $4 <** [$1,$2,$3]) $4 } > sbtype :: { BangType L } > : truebtype { UnBangedTy (ann $1) $1 } > | '!' trueatype { BangedTy (nIS $1 <++> ann $2 <** [$1]) $2 } > | '{-# UNPACK' '#-}' '!' trueatype { UnpackedTy (nIS $1 <++> ann $4 <** [$1,$2,$3]) $4 } > fielddecls :: { ([FieldDecl L],[S]) } > : fielddecls ',' fielddecl { ($3 : fst $1, $2 : snd $1) } > | fielddecl { ([$1],[]) } > fielddecl :: { FieldDecl L } > : vars '::' stype { let (ns,ss,l) = $1 in FieldDecl (l <++> ann $3 <** (reverse ss ++ [$2])) (reverse ns) $3 } > stype :: { BangType L } > : truectype { UnBangedTy (ann $1) $1 } > | '!' trueatype { BangedTy (nIS $1 <++> ann $2 <** [$1]) $2 } > | '{-# UNPACK' '#-}' '!' trueatype { UnpackedTy (nIS $1 <++> ann $4 <** [$1,$2,$3]) $4 } > deriving :: { Maybe (Deriving L) } > : {- empty -} { Nothing } > | 'deriving' qtycls1 { let l = nIS $1 <++> ann $2 <** [$1] in Just $ Deriving l [IHead (ann $2) $2 []] } > | 'deriving' '(' ')' { Just $ Deriving ($1 <^^> $3 <** [$1,$2,$3]) [] } > | 'deriving' '(' dclasses ')' { Just $ Deriving ($1 <^^> $4 <** $1:$2: reverse (snd $3) ++ [$4]) (reverse (fst $3)) } > dclasses :: { ([InstHead L],[S]) } > : types1 {% checkDeriving (fst $1) >>= \ds -> return (ds, snd $1) } > qtycls1 :: { QName L } > : qconid { $1 } ----------------------------------------------------------------------------- Kinds > kind :: { Kind L } > : kind1 {% checkEnabled KindSignatures >> return $1 } > kind1 :: { Kind L } > : akind { $1 } > | akind '->' kind1 { KindFn ($1 <> $3 <** [$2]) $1 $3 } > akind :: { Kind L } > : '*' { KindStar (nIS $1) } > | '!' { KindBang (nIS $1) } > | '(' kind1 ')' { KindParen ($1 <^^> $3 <** [$1,$3]) $2 } > optkind :: { (Maybe (Kind L), [S]) } > : {-empty-} { (Nothing,[]) } > | '::' kind { (Just $2,[$1]) } ----------------------------------------------------------------------------- Class declarations TODO: Lots of stuff to pass around here. No implicit parameters in the where clause of a class declaration. > optcbody :: { (Maybe [ClassDecl L],[S],Maybe L) } > : 'where' '{' cldecls '}' {% checkClassBody (fst $3) >>= \vs -> return (Just vs, $1:$2: snd $3 ++ [$4], Just ($1 <^^> $4)) } > | 'where' open cldecls close {% checkClassBody (fst $3) >>= \vs -> return (Just vs, $1:$2: snd $3 ++ [$4], Just ($1 <^^> $4)) } > | {- empty -} { (Nothing,[],Nothing) } > cldecls :: { ([ClassDecl L],[S]) } > : optsemis cldecls1 optsemis {% checkRevClsDecls (fst $2) >>= \cs -> return (cs, reverse $1 ++ snd $2 ++ reverse $3) } > | optsemis { ([],reverse $1) } > cldecls1 :: { ([ClassDecl L],[S]) } > : cldecls1 semis cldecl { ($3 : fst $1, snd $1 ++ reverse $2) } > | cldecl { ([$1],[]) } Associated types require the TypeFamilies extension. > cldecl :: { ClassDecl L } > : decl { ClsDecl (ann $1) $1 } > | atdecl {% checkEnabled TypeFamilies >> return $1 } > atdecl :: { ClassDecl L } > : 'type' type optkind > {% do { dh <- checkSimpleType $2; > return (ClsTyFam (nIS $1 <++> ann $2 <+?> (fmap ann) (fst $3) <** $1:snd $3) dh (fst $3)) } } > | 'type' truedtype '=' truectype > { ClsTyDef (nIS $1 <++> ann $4 <** [$1,$3]) $2 $4 } > | 'data' ctype optkind > {% do { (cs,dh) <- checkDataHeader $2; > return (ClsDataFam (nIS $1 <++> ann $2 <+?> (fmap ann) (fst $3) <** $1:snd $3) cs dh (fst $3)) } } ----------------------------------------------------------------------------- Instance declarations > optvaldefs :: { (Maybe [InstDecl L],[S],Maybe L) } > : 'where' '{' valdefs '}' {% checkInstBody (fst $3) >>= \vs -> return (Just vs, $1:$2: snd $3 ++ [$4], Just ($1 <^^> $4)) } > | 'where' open valdefs close {% checkInstBody (fst $3) >>= \vs -> return (Just vs, $1:$2: snd $3 ++ [$4], Just ($1 <^^> $4)) } > | {- empty -} { (Nothing, [], Nothing) } > valdefs :: { ([InstDecl L],[S]) } > : optsemis valdefs1 optsemis {% checkRevInstDecls (fst $2) >>= \is -> return (is, reverse $1 ++ snd $2 ++ reverse $3) } > | optsemis { ([],reverse $1) } > valdefs1 :: { ([InstDecl L],[S]) } > : valdefs1 semis insvaldef { ($3 : fst $1, snd $1 ++ reverse $2) } > | insvaldef { ([$1],[]) } Associated types require the TypeFamilies extension enabled. > insvaldef :: { InstDecl L } > : valdef { InsDecl (ann $1) $1 } > | atinst {% checkEnabled TypeFamilies >> return $1 } > | specinldecl { InsDecl (ann $1) $1 } inlinst :: { InstDecl L } : '{-# INLINE' activation qvar '#-}' { let Loc l (INLINE s) = $1 in InsInline (l <^^> $4 <** [l,$4]) s $2 $3 } > atinst :: { InstDecl L } > : 'type' truedtype '=' truectype > {% do { -- no checkSimpleType $4 since dtype may contain type patterns > return (InsType (nIS $1 <++> ann $4 <** [$1,$3]) $2 $4) } } > | data_or_newtype truectype constrs0 deriving > {% do { -- (cs,c,t) <- checkDataHeader $4; > let {(ds,ss,minf) = $3}; > checkDataOrNew $1 ds; > return (InsData ($1 <> $2 <+?> minf <+?> fmap ann $4 <** ss ) $1 $2 (reverse ds) $4) } } > | data_or_newtype truectype optkind gadtlist deriving > {% do { -- (cs,c,t) <- checkDataHeader $4; > let { (gs,ss,minf) = $4 } ; > checkDataOrNewG $1 gs; > return $ InsGData (ann $1 <+?> minf <+?> fmap ann $5 <** (snd $3 ++ ss)) $1 $2 (fst $3) (reverse gs) $5 } } ----------------------------------------------------------------------------- Value definitions > valdef :: { Decl L } > : exp0b optsig rhs optwhere {% checkValDef (($1 <> $3 <+?> (fmap ann) (fst $4)) <** (snd $2 ++ snd $4)) $1 (fst $2) $3 (fst $4) } > | '!' aexp rhs optwhere {% do { checkEnabled BangPatterns ; > let { l = nIS $1 <++> ann $2 <** [$1] }; > p <- checkPattern (BangPat l $2); > return $ PatBind (p <> $3 <+?> (fmap ann) (fst $4) <** snd $4) > p Nothing $3 (fst $4) } } May bind implicit parameters > optwhere :: { (Maybe (Binds L),[S]) } > : 'where' binds { (Just $2, [$1]) } > | {- empty -} { (Nothing, []) } Type signatures on value definitions require ScopedTypeVariables (or PatternSignatures, which is deprecated). > optsig :: { (Maybe (Type L),[S]) } > : '::' truectype {% checkEnabled ScopedTypeVariables >> return (Just $2, [$1]) } > | {- empty -} { (Nothing,[]) } > rhs :: { Rhs L } > : '=' trueexp { UnGuardedRhs (nIS $1 <++> ann $2 <** [$1]) $2 } > | gdrhs { GuardedRhss (snd $1) (reverse $ fst $1) } > gdrhs :: { ([GuardedRhs L],L) } > : gdrhs gdrh { ($2 : fst $1, snd $1 <++> ann $2) } > | gdrh { ([$1],ann $1) } Guards may contain patterns if PatternGuards is enabled, hence quals instead of exp. > gdrh :: { GuardedRhs L } > : '|' quals '=' trueexp {% do { checkPatternGuards (fst $2); > return $ GuardedRhs (nIS $1 <++> ann $4 <** ($1:snd $2 ++ [$3])) (reverse (fst $2)) $4 } } ----------------------------------------------------------------------------- Expressions Note: The Report specifies a meta-rule for lambda, let and if expressions (the exp's that end with a subordinate exp): they extend as far to the right as possible. That means they cannot be followed by a type signature or infix application. To implement this without shift/reduce conflicts, we split exp10 into these expressions (exp10a) and the others (exp10b). That also means that only an exp0 ending in an exp10b (an exp0b) can followed by a type signature or infix application. So we duplicate the exp0 productions to distinguish these from the others (exp0a). Ugly: We need non-parenthesized post-operators for HaRP, and to parse both these and normal left sections, we parse both as PostOp and let the post pass mangle them into the correct form depending on context. > trueexp :: { Exp L } > : exp {% checkExpr $1 } > exp :: { PExp L } > : exp0b '::' truectype { ExpTypeSig ($1 <> $3 <** [$2]) $1 $3 } > | exp0 { $1 } > | exp0b qop { PostOp ($1 <> $2) $1 $2 } > | exp0b '-<' exp { LeftArrApp ($1 <> $3 <** [$2]) $1 $3 } > | exp0b '>-' exp { RightArrApp ($1 <> $3 <** [$2]) $1 $3 } > | exp0b '-<<' exp { LeftArrHighApp ($1 <> $3 <** [$2]) $1 $3 } > | exp0b '>>-' exp { RightArrHighApp ($1 <> $3 <** [$2]) $1 $3 } > exp0 :: { PExp L } > : exp0a { $1 } > | exp0b { $1 } > exp0a :: { PExp L } > : exp0b qop exp10a { InfixApp ($1 <> $3) $1 $2 $3 } > | exp10a { $1 } > exp0b :: { PExp L } > : exp0b qop exp10b { InfixApp ($1 <> $3) $1 $2 $3 } > | exp10b { $1 } > exp10a :: { PExp L } > : '\\' apats '->' exp { Lambda (nIS $1 <++> ann $4 <** [$1,$3]) (reverse $2) $4 } A let may bind implicit parameters > | 'let' binds 'in' exp { Let (nIS $1 <++> ann $4 <** [$1,$3]) $2 $4 } > | 'if' exp optlayoutsemi 'then' exp optlayoutsemi 'else' exp > { If (nIS $1 <++> ann $8 <** ($1:$3 ++ $4:$6 ++ [$7])) $2 $5 $8 } > | 'proc' apat '->' exp { Proc (nIS $1 <++> ann $4 <** [$1,$3]) $2 $4 } > | exppragma { $1 } > optlayoutsemi :: { [S] } > : ';' {% checkEnabled DoAndIfThenElse >> return [$1] } > | {- empty -} { [] } We won't come here unless XmlSyntax is already checked. > opthsxsemi :: { [S] } > : ';' { [$1] } > | {- empty -} { [] } mdo blocks require the RecursiveDo extension enabled, but the lexer handles that. > exp10b :: { PExp L } > : 'case' exp 'of' altslist { let (als, inf, ss) = $4 in Case (nIS $1 <++> inf <** ($1:$3:ss)) $2 als } > | '-' fexp { NegApp (nIS $1 <++> ann $2 <** [$1]) $2 } > | 'do' stmtlist { let (sts, inf, ss) = $2 in Do (nIS $1 <++> inf <** $1:ss) sts } > | 'mdo' stmtlist { let (sts, inf, ss) = $2 in MDo (nIS $1 <++> inf <** $1:ss) sts } > | fexp { $1 } > exppragma :: { PExp L } > : '{-# CORE' STRING '#-}' exp { let Loc l (StringTok (s,_)) = $2 in CorePragma (nIS $1 <++> ann $4 <** [l,$3]) s $4 } > | '{-# SCC' STRING '#-}' exp { let Loc l (StringTok (s,_)) = $2 in SCCPragma (nIS $1 <++> ann $4 <** [l,$3]) s $4 } > | '{-# GENERATED' STRING INT ':' INT '-' INT ':' INT '#-}' exp > { let { Loc l0 (StringTok (s,_)) = $2; > Loc l1 (IntTok (i1,_)) = $3; > Loc l2 (IntTok (i2,_)) = $5; > Loc l3 (IntTok (i3,_)) = $7; > Loc l4 (IntTok (i4,_)) = $9} > in GenPragma (nIS $1 <++> ann $11 <** [$1,l0,l1,$4,l2,$6,l3,$8,l4,$10]) > s (fromInteger i1, fromInteger i2) > (fromInteger i3, fromInteger i4) $11 } > fexp :: { PExp L } > : fexp aexp { App ($1 <> $2) $1 $2 } > | aexp { $1 } > apats :: { [Pat L] } > : apats apat { $2 : $1 } > | apat { [$1] } > apat :: { Pat L } > : aexp {% checkPattern $1 } > | '!' aexp {% checkPattern (BangPat (nIS $1 <++> ann $2 <** [$1]) $2) } UGLY: Because patterns and expressions are mixed, aexp has to be split into two rules: One right-recursive and one left-recursive. Otherwise we get two reduce/reduce-errors (for as-patterns and irrefutable patters). Even though the variable in an as-pattern cannot be qualified, we use qvar here to avoid a shift/reduce conflict, and then check it ourselves (as for vars above). Non-linear name binding, @:, requires RegularPatterns, but the lexer handles that. > aexp :: { PExp L } > : qvar '@' aexp {% do { n <- checkUnQual $1; > return (AsPat ($1 <> $3 <** [$2]) n $3) } } > | qvar '@:' aexp {% do { n <- checkUnQual $1; > return (CAsRP ($1 <> $3 <** [$2]) n $3) } } > | '~' aexp { IrrPat (nIS $1 <++> ann $2 <** [$1]) $2 } > | aexp1 { $1 } Note: The first two alternatives of aexp1 are not necessarily record updates: they could be labeled constructions. Generics-style explicit type arguments need the Generics extension, but we check that in the lexer. > aexp1 :: { PExp L } > : aexp1 '{' '}' {% liftM (amap (const (ann $1 <++> nIS $3 <** [$2,$3]))) $ mkRecConstrOrUpdate $1 [] } > | aexp1 '{' fbinds '}' {% liftM (amap (const (ann $1 <++> nIS $4 <** ($2:reverse (snd $3) ++ [$4])))) > $ mkRecConstrOrUpdate $1 (reverse (fst $3)) } > | qvar '{|' truetype '|}' { ExplTypeArg (ann $1 <++> nIS $4 <** [$2,$4]) $1 $3 } > | aexp2 { $1 } According to the Report, the left section (e op) is legal iff (e op x) parses equivalently to ((e) op x). Thus e must be an exp0b. An implicit parameter can be used as an expression, enabled by the lexer. Extensions using banana brackets are also enabled by the lexer. The only thing we need to look at here is the erpats that use no non-standard lexemes. > aexp2 :: { PExp L } > : ivar { IPVar (ann $1) $1 } > | qvar { Var (ann $1) $1 } > | gcon { $1 } > | literal { Lit (ann $1) $1 } > | '(' texp ')' { Paren ($1 <^^> $3 <** [$1,$3]) $2 } > | '(' texp tsectend { TupleSection ($1 <^^> head (snd $3) <** $1:reverse (snd $3)) Boxed (Just $2 : fst $3) } > | '(' commas texp ')' { TupleSection ($1 <^^> $4 <** $1:reverse ($4:$2)) Boxed > (replicate (length $2) Nothing ++ [Just $3]) } > | '(' commas texp tsectend { TupleSection ($1 <^^> head (snd $4) <** $1:reverse (snd $4 ++ $2)) Boxed > (replicate (length $2) Nothing ++ Just $3 : fst $4) } > | '(#' texp thashsectend { TupleSection ($1 <^^> head (snd $3) <** $1:reverse (snd $3)) Unboxed (Just $2 : fst $3) } > | '(#' texp '#)' { TupleSection ($1 <^^> $3 <** [$1,$3]) Unboxed [Just $2] } > | '(#' commas texp '#)' { TupleSection ($1 <^^> $4 <** $1:reverse ($4:$2)) Unboxed > (replicate (length $2) Nothing ++ [Just $3]) } > | '(#' commas texp thashsectend { TupleSection ($1 <^^> head (snd $4) <** $1:reverse (snd $4 ++ $2)) Unboxed > (replicate (length $2) Nothing ++ Just $3 : fst $4) } > | '[' list ']' { amap (\l -> l <** [$3]) $ $2 ($1 <^^> $3 <** [$1]) } > | '_' { WildCard (nIS $1) } > | '(' erpats ')' {% checkEnabled RegularPatterns >> return (Paren ($1 <^^> $3 <** [$1,$3]) $2) } > | '(|' sexps '|)' { SeqRP ($1 <^^> $3 <** ($1:reverse (snd $2) ++ [$3])) $ reverse (fst $2) } > | '(|' exp '|' quals '|)' { GuardRP ($1 <^^> $5 <** ($1:$3 : snd $4 ++ [$5])) $2 $ (reverse $ fst $4) } > | xml { $1 } Template Haskell - all this is enabled in the lexer. > | IDSPLICE { let Loc l (THIdEscape s) = $1 in SpliceExp (nIS l) $ IdSplice (nIS l) s } > | '$(' trueexp ')' { SpliceExp ($1 <^^> $3 <** [$1,$3]) $ ParenSplice (ann $2) $2 } > | '[|' trueexp '|]' { BracketExp ($1 <^^> $3 <** [$1,$3]) $ ExpBracket (ann $2) $2 } > | '[p|' exp0 '|]' {% do { p <- checkPattern $2; > return $ BracketExp ($1 <^^> $3 <** [$1,$3]) $ PatBracket (ann p) p } } > | '[t|' truectype '|]' { let l = $1 <^^> $3 <** [$1,$3] in BracketExp l $ TypeBracket l $2 } > | '[d|' open topdecls close '|]' { let l = $1 <^^> $5 <** ($1:snd $3 ++ [$5]) in BracketExp l $ DeclBracket l (fst $3) } > | VARQUOTE qvar { VarQuote (nIS $1 <++> ann $2 <** [$1]) $2 } > | VARQUOTE qcon { VarQuote (nIS $1 <++> ann $2 <** [$1]) $2 } > | TYPQUOTE tyvar { TypQuote (nIS $1 <++> ann $2 <** [$1]) (UnQual (ann $2) $2) } > | TYPQUOTE gtycon { TypQuote (nIS $1 <++> ann $2 <** [$1]) $2 } > | QUASIQUOTE { let Loc l (THQuasiQuote (n,q)) = $1 in QuasiQuote (nIS l) n q } End Template Haskell > commas :: { [S] } > : commas ',' { $2 : $1 } > | ',' { [$1] } > texp :: { PExp L } > : exp { $1 } > | qopm exp0 { PreOp ($1 <> $2) $1 $2 } > | exp '->' exp {% do {checkEnabled ViewPatterns; > return $ ViewPat ($1 <> $3 <** [$2]) $1 $3} } > tsectend :: { ([Maybe (PExp L)],[S]) } > : commas texp tsectend { let (mes, ss) = $3 in (replicate (length $1 - 1) Nothing ++ Just $2 : mes, ss ++ $1) } > | commas texp ')' { (replicate (length $1 - 1) Nothing ++ [Just $2], $3 : $1) } > | commas ')' { (replicate (length $1) Nothing, $2 : $1) } > thashsectend :: { ([Maybe (PExp L)],[S]) } > : commas texp thashsectend { let (mes, ss) = $3 in (replicate (length $1 - 1) Nothing ++ Just $2 : mes, ss ++ $1) } > | commas texp '#)' { (replicate (length $1 - 1) Nothing ++ [Just $2], $3 : $1) } > | commas '#)' { (replicate (length $1) Nothing, $2 : $1) } ----------------------------------------------------------------------------- Harp Extensions > sexps :: { ([PExp L],[S]) } > : sexps ',' exp { ($3 : fst $1, $2 : snd $1) } > | exp { ([$1],[]) } Either patterns are left associative > erpats :: { PExp L } > : exp '|' erpats { EitherRP ($1 <> $3 <** [$2]) $1 $3 } > | exp '|' exp { EitherRP ($1 <> $3 <** [$2]) $1 $3 } ----------------------------------------------------------------------------- Hsx Extensions - requires XmlSyntax, but the lexer handles all that. > xml :: { PExp L } > : '<' name attrs mattr '>' children opthsxsemi '' > {% do { n <- checkEqNames $2 $9; > let { cn = reverse $6; > as = reverse $3; > l = $1 <^^> $10 <** [$1,$5] ++ $7 ++ [$8,srcInfoSpan (ann $9),$10] }; > return $ XTag l n as $4 cn } } > | '<' name attrs mattr '/>' { XETag ($1 <^^> $5 <** [$1,$5]) $2 (reverse $3) $4 } > | '<%' exp '%>' { XExpTag ($1 <^^> $3 <** [$1,$3]) $2 } > | '<%>' children opthsxsemi '' { XChildTag ($1 <^^> $5 <** ($1:$3++[$4,$5])) (reverse $2) } > children :: { [PExp L] } > : children child { $2 : $1 } > | {- empty -} { [] } > child :: { PExp L } > : PCDATA { let Loc l (XPCDATA pcd) = $1 in XPcdata (nIS l) pcd } > | '<[' sexps ']>' { XRPats ($1 <^^> $3 <** (snd $2 ++ [$1,$3])) $ reverse (fst $2) } > | xml { $1 } > name :: { XName L } > : xmlname ':' xmlname { let {Loc l1 s1 = $1; Loc l2 s2 = $3} > in XDomName (nIS l1 <++> nIS l2 <** [l1,$2,l2]) s1 s2 } > | xmlname { let Loc l str = $1 in XName (nIS l) str } > xmlname :: { Loc String } > : VARID { let Loc l (VarId s) = $1 in Loc l s } > | CONID { let Loc l (ConId s) = $1 in Loc l s } > | DVARID { let Loc l (DVarId s) = $1 in Loc l $ mkDVar s } > | xmlkeyword { $1 } > xmlkeyword :: { Loc String } > : 'type' { Loc $1 "type" } > | 'class' { Loc $1 "class" } > | 'data' { Loc $1 "data" } > | 'foreign' { Loc $1 "foreign" } > | 'export' { Loc $1 "export" } > | 'safe' { Loc $1 "safe" } > | 'unsafe' { Loc $1 "unsafe" } > | 'threadsafe' { Loc $1 "threadsafe" } > | 'stdcall' { Loc $1 "stdcall" } > | 'ccall' { Loc $1 "ccall" } > | 'cplusplus' { Loc $1 "cplusplus" } > | 'dotnet' { Loc $1 "dotnet" } > | 'jvm' { Loc $1 "jvm" } > | 'js' { Loc $1 "js" } > | 'as' { Loc $1 "as" } > | 'by' { Loc $1 "by" } > | 'case' { Loc $1 "case" } > | 'default' { Loc $1 "default" } > | 'deriving' { Loc $1 "deriving" } > | 'do' { Loc $1 "do" } > | 'else' { Loc $1 "else" } > | 'family' { Loc $1 "family" } > | 'forall' { Loc $1 "forall" } > | 'group' { Loc $1 "group" } > | 'hiding' { Loc $1 "hiding" } > | 'if' { Loc $1 "if" } > | 'import' { Loc $1 "import" } > | 'in' { Loc $1 "in" } > | 'infix' { Loc $1 "infix" } > | 'infixl' { Loc $1 "infixl" } > | 'infixr' { Loc $1 "infixr" } > | 'instance' { Loc $1 "instance" } > | 'let' { Loc $1 "let" } > | 'mdo' { Loc $1 "mdo" } > | 'module' { Loc $1 "module" } > | 'newtype' { Loc $1 "newtype" } > | 'of' { Loc $1 "of" } > | 'proc' { Loc $1 "proc" } > | 'rec' { Loc $1 "rec" } > | 'then' { Loc $1 "then" } > | 'using' { Loc $1 "using" } > | 'where' { Loc $1 "where" } > | 'qualified' { Loc $1 "qualified" } > attrs :: { [ParseXAttr L] } > : attrs attr { $2 : $1 } > | {- empty -} { [] } > attr :: { ParseXAttr L } > : name '=' aexp { XAttr ($1 <> $3 <** [$2]) $1 $3 } > mattr :: { Maybe (PExp L) } > : aexp { Just $1 } > | {-empty-} { Nothing } ----------------------------------------------------------------------------- List expressions The rules below are little bit contorted to keep lexps left-recursive while avoiding another shift/reduce-conflict. > list :: { L -> PExp L } > : texp { \l -> List l [$1] } > | lexps { \l -> let (ps,ss) = $1 in List (l <** reverse ss) (reverse ps) } > | texp '..' { \l -> EnumFrom (l <** [$2]) $1 } > | texp ',' exp '..' { \l -> EnumFromThen (l <** [$2,$4]) $1 $3 } > | texp '..' exp { \l -> EnumFromTo (l <** [$2]) $1 $3 } > | texp ',' exp '..' exp { \l -> EnumFromThenTo (l <** [$2,$4]) $1 $3 $5 } > | texp '|' pqualstmts { \l -> let (stss, ss) = $3 in ParComp (l <** ($2:ss)) $1 (reverse stss) } > lexps :: { ([PExp L],[S]) } > : lexps ',' texp { let (es, ss) = $1 in ($3 : es, $2 : ss) } > | texp ',' texp { ([$3,$1], [$2]) } ----------------------------------------------------------------------------- List comprehensions > pqualstmts :: { ([[QualStmt L]],[S]) } > : pqualstmts '|' qualstmts { let { (stss, ss1) = $1; > (sts, ss2) = $3 } > in (reverse sts : stss, ss1 ++ [$2] ++ reverse ss2) } > | qualstmts { let (sts, ss) = $1 in ([reverse sts], reverse ss) } > qualstmts :: { ([QualStmt L],[S]) } > : qualstmts ',' qualstmt { let (sts, ss) = $1 in ($3 : sts, $2 : ss) } > | qualstmt { ([$1],[]) } > qualstmt :: { QualStmt L } > : transformqual { $1 } > | qual { QualStmt (ann $1) $1 } > transformqual :: { QualStmt L } > : 'then' trueexp { ThenTrans (nIS $1 <++> ann $2 <** [$1]) $2 } > | 'then' trueexp 'by' trueexp { ThenBy (nIS $1 <++> ann $4 <** [$1,$3]) $2 $4 } > | 'then' 'group' 'by' trueexp { GroupBy (nIS $1 <++> ann $4 <** [$1,$2,$3]) $4 } > | 'then' 'group' 'using' trueexp { GroupUsing (nIS $1 <++> ann $4 <** [$1,$2,$3]) $4 } > | 'then' 'group' 'by' trueexp 'using' trueexp { GroupByUsing (nIS $1 <++> ann $6 <** [$1,$2,$3,$5]) $4 $6 } > quals :: { ([Stmt L],[S]) } > : quals ',' qual { let (sts, ss) = $1 in ($3 : sts, $2 : ss) } > | qual { ([$1],[]) } > qual :: { Stmt L } > : pat '<-' trueexp { Generator ($1 <> $3 <** [$2]) $1 $3 } > | trueexp { Qualifier (ann $1) $1 } > | 'let' binds { LetStmt (nIS $1 <++> ann $2 <** [$1]) $2 } ----------------------------------------------------------------------------- Case alternatives > altslist :: { ([Alt L],L,[S]) } > : '{' alts '}' { (fst $2, $1 <^^> $3, $1:snd $2 ++ [$3]) } > | open alts close { (fst $2, $1 <^^> $3, $1:snd $2 ++ [$3]) } > alts :: { ([Alt L],[S]) } > : optsemis alts1 optsemis { (reverse $ fst $2, $1 ++ snd $2 ++ $3) } > alts1 :: { ([Alt L],[S]) } > : alts1 semis alt { ($3 : fst $1, snd $1 ++ $2) } > | alt { ([$1],[]) } > alt :: { Alt L } > : pat ralt optwhere { Alt ($1 <> $2 <+?> (fmap ann) (fst $3) <** snd $3) $1 $2 (fst $3) } > ralt :: { GuardedAlts L } > : '->' trueexp { UnGuardedAlt (nIS $1 <++> ann $2 <** [$1]) $2 } > | gdpats { GuardedAlts (snd $1) (reverse $ fst $1) } > gdpats :: { ([GuardedAlt L],L) } > : gdpats gdpat { ($2 : fst $1, snd $1 <++> ann $2) } > | gdpat { ([$1], ann $1) } A guard can be a pattern guard if PatternGuards is enabled, hence quals instead of exp0. > gdpat :: { GuardedAlt L } > : '|' quals '->' trueexp {% do { checkPatternGuards (fst $2); > let {l = nIS $1 <++> ann $4 <** ($1:snd $2 ++ [$3])}; > return (GuardedAlt l (reverse (fst $2)) $4) } } > pat :: { Pat L } > : exp {% checkPattern $1 } > | '!' aexp {% checkPattern (BangPat (nIS $1 <++> ann $2 <** [$1]) $2) } ----------------------------------------------------------------------------- Statement sequences As per the Report, but with stmt expanded to simplify building the list without introducing conflicts. This also ensures that the last stmt is an expression. TODO: The points can't be added here, must be propagated! > stmtlist :: { ([Stmt L],L,[S]) } > : '{' stmts '}' { (fst $2, $1 <^^> $3, $1:snd $2 ++ [$3]) } > | open stmts close { (fst $2, $1 <^^> $3, $1:snd $2 ++ [$3]) } > stmts :: { ([Stmt L],[S]) } > : stmt stmts1 { ($1 : fst $2, snd $2) } > | ';' stmts { (fst $2, $1 : snd $2) } > | {- empty -} { ([],[]) } > stmts1 :: { ([Stmt L],[S]) } > : ';' stmts { (fst $2, $1 : snd $2) } > | {- empty -} { ([],[]) } A let statement may bind implicit parameters. > stmt :: { Stmt L } > : 'let' binds { LetStmt (nIS $1 <++> ann $2 <** [$1]) $2 } > | pat '<-' trueexp { Generator ($1 <> $3 <** [$2]) $1 $3 } > | trueexp { Qualifier (ann $1) $1 } > | 'rec' stmtlist { let (stms,inf,ss) = $2 in RecStmt (nIS $1 <++> inf <** $1:ss) stms } ----------------------------------------------------------------------------- Record Field Update/Construction > fbinds :: { ([PFieldUpdate L],[S]) } > : fbinds ',' fbind { let (fbs, ss) = $1 in ($3 : fbs, $2 : ss) } > | fbind { ([$1],[]) } Puns and wild cards need the respective extensions enabled. > fbind :: { PFieldUpdate L } > : qvar '=' exp { FieldUpdate ($1 <>$3 <** [$2]) $1 $3 } > | qvar {% checkEnabled NamedFieldPuns >> checkUnQual $1 >>= return . FieldPun (ann $1) } > | '..' {% checkEnabled RecordWildCards >> return (FieldWildcard (nIS $1)) } ----------------------------------------------------------------------------- Implicit parameter bindings - need the ImplicitParameter extension enabled, but the lexer handles that. > ipbinds :: { ([IPBind L],[S]) } > : optsemis ipbinds1 optsemis { (reverse (fst $2), reverse $1 ++ snd $2 ++ reverse $3) } > ipbinds1 :: { ([IPBind L],[S]) } > : ipbinds1 semis ipbind { ($3 : fst $1, snd $1 ++ reverse $2) } > | ipbind { ([$1],[]) } > ipbind :: { IPBind L } > : ivar '=' trueexp { IPBind ($1 <> $3 <** [$2]) $1 $3 } ----------------------------------------------------------------------------- Variables, Constructors and Operators. > gcon :: { PExp L } > : '(' ')' { p_unit_con ($1 <^^> $2 <** [$1,$2]) } > | '[' ']' { List ($1 <^^> $2 <** [$1,$2]) [] } > | '(' commas ')' { p_tuple_con ($1 <^^> $3 <** $1:reverse ($3:$2)) Boxed (length $2) } > | '(#' '#)' { p_unboxed_singleton_con ($1 <^^> $2 <** [$1,$2]) } > | '(#' commas '#)' { p_tuple_con ($1 <^^> $3 <** $1:reverse ($3:$2)) Unboxed (length $2) } > | qcon { Con (ann $1) $1 } > var :: { Name L } > : varid { $1 } > | '(' varsym ')' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > var_no_safety :: { Name L } > : varid_no_safety { $1 } > | '(' varsym ')' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > qvar :: { QName L } > : qvarid { $1 } > | '(' qvarsym ')' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } Implicit parameter > ivar :: { IPName L } > : ivarid { $1 } > con :: { Name L } > : conid { $1 } > | '(' consym ')' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > qcon :: { QName L } > : qconid { $1 } > | '(' gconsym ')' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > varop :: { Name L } > : varsym { $1 } > | '`' varid '`' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > qvarop :: { QName L } > : qvarsym { $1 } > | '`' qvarid '`' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > qvaropm :: { QName L } > : qvarsymm { $1 } > | '`' qvarid '`' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > conop :: { Name L } > : consym { $1 } > | '`' conid '`' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > qconop :: { QName L } > : gconsym { $1 } > | '`' qconid '`' { fmap (const ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3])) $2 } > op :: { Op L } > : varop { VarOp (ann $1) $1 } > | conop { ConOp (ann $1) $1 } > qop :: { QOp L } > : qvarop { QVarOp (ann $1) $1 } > | qconop { QConOp (ann $1) $1 } > qopm :: { QOp L } > : qvaropm { QVarOp (ann $1) $1 } > | qconop { QConOp (ann $1) $1 } > gconsym :: { QName L } > : ':' { list_cons_name (nIS $1) } > | qconsym { $1 } ----------------------------------------------------------------------------- Identifiers and Symbols > qvarid :: { QName L } > : varid { UnQual (ann $1) $1 } > | QVARID { let {Loc l (QVarId q) = $1; nis = nIS l} > in Qual nis (ModuleName nis (fst q)) (Ident nis (snd q)) } > varid_no_safety :: { Name L } > : VARID { let Loc l (VarId v) = $1 in Ident (nIS l) v } > | 'as' { as_name (nIS $1) } > | 'qualified' { qualified_name (nIS $1) } > | 'hiding' { hiding_name (nIS $1) } > | 'export' { export_name (nIS $1) } > | 'stdcall' { stdcall_name (nIS $1) } > | 'ccall' { ccall_name (nIS $1) } > | 'cplusplus' { cplusplus_name (nIS $1) } > | 'dotnet' { dotnet_name (nIS $1) } > | 'jvm' { jvm_name (nIS $1) } > | 'js' { js_name (nIS $1) } > varid :: { Name L } > : varid_no_safety { $1 } > | 'safe' { safe_name (nIS $1) } > | 'unsafe' { unsafe_name (nIS $1) } > | 'threadsafe' { threadsafe_name (nIS $1) } > | 'forall' { forall_name (nIS $1) } > | 'family' { family_name (nIS $1) } Implicit parameter > ivarid :: { IPName L } > : IDUPID { let Loc l (IDupVarId i) = $1 in IPDup (nIS l) i } > | ILINID { let Loc l (ILinVarId i) = $1 in IPLin (nIS l) i } > qconid :: { QName L } > : conid { UnQual (ann $1) $1 } > | QCONID { let {Loc l (QConId q) = $1; nis = nIS l} in Qual nis (ModuleName nis (fst q)) (Ident nis (snd q)) } > conid :: { Name L } > : CONID { let Loc l (ConId c) = $1 in Ident (nIS l) c } > qconsym :: { QName L } > : consym { UnQual (ann $1) $1 } > | QCONSYM { let {Loc l (QConSym q) = $1; nis = nIS l} in Qual nis (ModuleName nis (fst q)) (Symbol nis (snd q)) } > consym :: { Name L } > : CONSYM { let Loc l (ConSym c) = $1 in Symbol (nIS l) c } > qvarsym :: { QName L } > : varsym { UnQual (ann $1) $1 } > | qvarsym1 { $1 } > qvarsymm :: { QName L } > : varsymm { UnQual (ann $1) $1 } > | qvarsym1 { $1 } > varsym :: { Name L } > : VARSYM { let Loc l (VarSym v) = $1 in Symbol (nIS l) v } > | '-' { minus_name (nIS $1) } > | '!' { bang_name (nIS $1) } > | '.' { dot_name (nIS $1) } > | '*' { star_name (nIS $1) } > varsymm :: { Name L } -- varsym not including '-' > : VARSYM { let Loc l (VarSym v) = $1 in Symbol (nIS l) v } > | '!' { bang_name (nIS $1) } > | '.' { dot_name (nIS $1) } > | '*' { star_name (nIS $1) } > qvarsym1 :: { QName L } > : QVARSYM { let {Loc l (QVarSym q) = $1; nis = nIS l} in Qual nis (ModuleName nis (fst q)) (Symbol nis (snd q)) } > literal :: { Literal L } > : INT { let Loc l (IntTok (i,raw)) = $1 in Int (nIS l) i raw } > | CHAR { let Loc l (Character (c,raw)) = $1 in Char (nIS l) c raw } > | RATIONAL { let Loc l (FloatTok (r,raw)) = $1 in Frac (nIS l) r raw } > | STRING { let Loc l (StringTok (s,raw)) = $1 in String (nIS l) s raw } > | PRIMINT { let Loc l (IntTokHash (i,raw)) = $1 in PrimInt (nIS l) i raw } > | PRIMWORD { let Loc l (WordTokHash (w,raw)) = $1 in PrimWord (nIS l) w raw } > | PRIMFLOAT { let Loc l (FloatTokHash (f,raw)) = $1 in PrimFloat (nIS l) f raw } > | PRIMDOUBLE { let Loc l (DoubleTokHash (d,raw)) = $1 in PrimDouble (nIS l) d raw } > | PRIMCHAR { let Loc l (CharacterHash (c,raw)) = $1 in PrimChar (nIS l) c raw } > | PRIMSTRING { let Loc l (StringHash (s,raw)) = $1 in PrimString (nIS l) s raw } ----------------------------------------------------------------------------- Layout > open :: { S } : {% pushCurrentContext >> getSrcLoc >>= \s -> return $ mkSrcSpan s s {- >>= \x -> trace (show x) (return x) -} } > close :: { S } > : vccurly { $1 {- >>= \x -> trace (show x ++ show x ++ show x) (return x) -} } -- context popped in lexer. > | error {% popContext >> getSrcLoc >>= \s -> return $ mkSrcSpan s s {- >>= \x -> trace (show x ++ show x) (return x) -} } ----------------------------------------------------------------------------- Miscellaneous (mostly renamings) > modid :: { ModuleName L } > : CONID { let Loc l (ConId n) = $1 in ModuleName (nIS l) n } > | QCONID { let Loc l (QConId n) = $1 in ModuleName (nIS l) (fst n ++ '.':snd n) } > tyconorcls :: { Name L } > : con { $1 } > qtyconorcls :: { QName L } > : qcon { $1 } > tyvar :: { Name L } > : tyvarid { $1 } > tyvarid :: { Name L } > : varid_no_safety { $1 } > | 'safe' { safe_name (nIS $1) } > | 'unsafe' { unsafe_name (nIS $1) } > | 'threadsafe' { threadsafe_name (nIS $1) } | 'forall' { forall_name (nIS $1) } | 'family' { family_name (nIS $1) } > qtyvarop :: { QName L } > qtyvarop : '`' tyvar '`' { UnQual ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3]) $2 } > | tyvarsym { UnQual (ann $1) $1 } > tyvarsym :: { Name L } > tyvarsym : VARSYM { let Loc l (VarSym x) = $1 in Symbol (nIS l) x } ----------------------------------------------------------------------------- > { > type L = SrcSpanInfo -- just for convenience > type S = SrcSpan > parseError :: Loc Token -> P a > parseError t = fail $ "Parse error: " ++ showToken (unLoc t) > (<>) :: (Annotated a, Annotated b) => a SrcSpanInfo -> b SrcSpanInfo -> SrcSpanInfo > a <> b = ann a <++> ann b > > infixl 6 <> > nIS = noInfoSpan > iS = infoSpan > -- | Parse of a string, which should contain a complete Haskell module. > parseModule :: String -> ParseResult (Module SrcSpanInfo) > parseModule = simpleParse mparseModule > -- | Parse of a string containing a complete Haskell module, using an explicit mode. > parseModuleWithMode :: ParseMode -> String -> ParseResult (Module SrcSpanInfo) > parseModuleWithMode = modeParse mparseModule > -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. > parseModuleWithComments :: ParseMode -> String -> ParseResult (Module SrcSpanInfo, [Comment]) > parseModuleWithComments = commentParse mparseModule > -- | Parse of a string containing a Haskell expression. > parseExp :: String -> ParseResult (Exp SrcSpanInfo) > parseExp = simpleParse mparseExp > -- | Parse of a string containing a Haskell expression, using an explicit mode. > parseExpWithMode :: ParseMode -> String -> ParseResult (Exp SrcSpanInfo) > parseExpWithMode = modeParse mparseExp > -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. > parseExpWithComments :: ParseMode -> String -> ParseResult (Exp SrcSpanInfo, [Comment]) > parseExpWithComments = commentParse mparseExp > -- | Parse of a string containing a Haskell pattern. > parsePat :: String -> ParseResult (Pat SrcSpanInfo) > parsePat = simpleParse mparsePat > -- | Parse of a string containing a Haskell pattern, using an explicit mode. > parsePatWithMode :: ParseMode -> String -> ParseResult (Pat SrcSpanInfo) > parsePatWithMode = modeParse mparsePat > -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. > parsePatWithComments :: ParseMode -> String -> ParseResult (Pat SrcSpanInfo, [Comment]) > parsePatWithComments = commentParse mparsePat > -- | Parse of a string containing a Haskell top-level declaration. > parseDecl :: String -> ParseResult (Decl SrcSpanInfo) > parseDecl = simpleParse mparseDecl > -- | Parse of a string containing a Haskell top-level declaration, using an explicit mode. > parseDeclWithMode :: ParseMode -> String -> ParseResult (Decl SrcSpanInfo) > parseDeclWithMode = modeParse mparseDecl > -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. > parseDeclWithComments :: ParseMode -> String -> ParseResult (Decl SrcSpanInfo, [Comment]) > parseDeclWithComments = commentParse mparseDecl > -- | Parse of a string containing a Haskell type. > parseType :: String -> ParseResult (Type SrcSpanInfo) > parseType = runParser mparseType > -- | Parse of a string containing a Haskell type, using an explicit mode. > parseTypeWithMode :: ParseMode -> String -> ParseResult (Type SrcSpanInfo) > parseTypeWithMode mode = runParserWithMode mode mparseType > -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. > parseTypeWithComments :: ParseMode -> String -> ParseResult (Type SrcSpanInfo, [Comment]) > parseTypeWithComments mode str = runParserWithModeComments mode mparseType str > -- | Parse of a string containing a Haskell statement. > parseStmt :: String -> ParseResult (Stmt SrcSpanInfo) > parseStmt = runParser mparseStmt > -- | Parse of a string containing a Haskell type, using an explicit mode. > parseStmtWithMode :: ParseMode -> String -> ParseResult (Stmt SrcSpanInfo) > parseStmtWithMode mode = runParserWithMode mode mparseStmt > -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. > parseStmtWithComments :: ParseMode -> String -> ParseResult (Stmt SrcSpanInfo, [Comment]) > parseStmtWithComments mode str = runParserWithModeComments mode mparseStmt str > simpleParse :: AppFixity a => P (a L) -> String -> ParseResult (a L) > simpleParse p = applyFixities preludeFixities <=< runParser p > modeParse :: AppFixity a => P (a L) -> ParseMode -> String -> ParseResult (a L) > modeParse p mode = applyFixities' (fixities mode) <=< runParserWithMode mode p > commentParse :: AppFixity a => P (a L) -> ParseMode -> String -> ParseResult (a L, [Comment]) > commentParse p mode str = do (ast, cs) <- runParserWithModeComments mode p str > ast' <- applyFixities' (fixities mode) ast > return (ast', cs) > -- | Partial parse of a string starting with a series of top-level option pragmas. > getTopPragmas :: String -> ParseResult [ModulePragma SrcSpanInfo] > getTopPragmas = runParser (mfindOptPragmas >>= \(ps,_,_) -> return ps) > -- | Parse of a string, which should contain a complete Haskell module. > parseModules :: String -> ParseResult [Module SrcSpanInfo] > parseModules = mapM (applyFixities preludeFixities) <=< runParser mparseModules > -- | Parse of a string containing a complete Haskell module, using an explicit mode. > parseModulesWithMode :: ParseMode -> String -> ParseResult [Module SrcSpanInfo] > parseModulesWithMode mode = mapM (applyFixities' (fixities mode)) <=< runParserWithMode mode mparseModules > -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments. > parseModulesWithComments :: ParseMode -> String -> ParseResult ([Module SrcSpanInfo], [Comment]) > parseModulesWithComments mode str = do (ast,cs) <- runParserWithModeComments mode mparseModules str > ast' <- mapM (applyFixities' (fixities mode)) ast > return (ast', cs) > > applyFixities' :: (AppFixity a) => Maybe [Fixity] -> a L -> ParseResult (a L) > applyFixities' Nothing ast = return ast > applyFixities' (Just fixs) ast = applyFixities fixs ast > > } haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Annotated/0000755000000000000000000000000012204617765021723 5ustar0000000000000000haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Annotated/Syntax.hs0000644000000000000000000026074712204617765023565 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFoldable, DeriveTraversable #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Annotated.Syntax -- Copyright : (c) Niklas Broberg 2004-2009, -- (c) The GHC Team, 1997-2000 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- A suite of datatypes describing the (semi-concrete) abstract syntax of Haskell 98 -- plus registered extensions, including: -- -- * multi-parameter type classes with functional dependencies (MultiParamTypeClasses, FunctionalDependencies) -- -- * parameters of type class assertions are unrestricted (FlexibleContexts) -- -- * 'forall' types as universal and existential quantification (RankNTypes, ExistentialQuantification, etc) -- -- * pattern guards (PatternGuards) -- -- * implicit parameters (ImplicitParameters) -- -- * generalised algebraic data types (GADTs) -- -- * template haskell (TemplateHaskell) -- -- * empty data type declarations (EmptyDataDecls) -- -- * unboxed tuples (UnboxedTuples) -- -- * regular patterns (RegularPatterns) -- -- * HSP-style XML expressions and patterns (XmlSyntax) -- -- All nodes in the syntax tree are annotated with something of a user-definable data type. -- When parsing, this annotation will contain information about the source location that the -- particular node comes from. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Annotated.Syntax ( -- * Modules Module(..), ModuleHead(..), WarningText(..), ExportSpecList(..), ExportSpec(..), ImportDecl(..), ImportSpecList(..), ImportSpec(..), Assoc(..), -- * Declarations Decl(..), DeclHead(..), InstHead(..), Binds(..), IPBind(..), -- ** Type classes and instances ClassDecl(..), InstDecl(..), Deriving(..), -- ** Data type declarations DataOrNew(..), ConDecl(..), FieldDecl(..), QualConDecl(..), GadtDecl(..), BangType(..), -- ** Function bindings Match(..), Rhs(..), GuardedRhs(..), -- * Class Assertions and Contexts Context(..), FunDep(..), Asst(..), -- * Types Type(..), Boxed(..), Kind(..), TyVarBind(..), -- * Expressions Exp(..), Stmt(..), QualStmt(..), FieldUpdate(..), Alt(..), GuardedAlts(..), GuardedAlt(..), XAttr(..), -- * Patterns Pat(..), PatField(..), PXAttr(..), RPat(..), RPatOp(..), -- * Literals Literal(..), -- * Variables, Constructors and Operators ModuleName(..), QName(..), Name(..), QOp(..), Op(..), SpecialCon(..), CName(..), IPName(..), XName(..), -- * Template Haskell Bracket(..), Splice(..), -- * FFI Safety(..), CallConv(..), -- * Pragmas ModulePragma(..), Tool(..), Rule(..), RuleVar(..), Activation(..), Annotation(..), -- * Builtin names -- ** Modules prelude_mod, main_mod, -- ** Main function of a program main_name, -- ** Constructors unit_con_name, tuple_con_name, list_cons_name, unboxed_singleton_con_name, unit_con, tuple_con, unboxed_singleton_con, -- ** Special identifiers as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name, export_name, safe_name, unsafe_name, threadsafe_name, stdcall_name, ccall_name, cplusplus_name, dotnet_name, jvm_name, js_name, forall_name, family_name, -- ** Type constructors unit_tycon_name, fun_tycon_name, list_tycon_name, tuple_tycon_name, unboxed_singleton_tycon_name, unit_tycon, fun_tycon, list_tycon, tuple_tycon, unboxed_singleton_tycon, -- * Source coordinates -- SrcLoc(..), -- * Annotated trees Annotated(..), (=~=), ) where #ifdef __GLASGOW_HASKELL__ #ifdef BASE4 import Data.Data #else import Data.Generics (Data(..),Typeable(..)) #endif #endif import Data.Foldable (Foldable) import Data.Traversable (Traversable) -- | The name of a Haskell module. data ModuleName l = ModuleName l String #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Constructors with special syntax. -- These names are never qualified, and always refer to builtin type or -- data constructors. data SpecialCon l = UnitCon l -- ^ unit type and data constructor @()@ | ListCon l -- ^ list type constructor @[]@ | FunCon l -- ^ function type constructor @->@ | TupleCon l Boxed Int -- ^ /n/-ary tuple type and data -- constructors @(,)@ etc, possibly boxed @(\#,\#)@ | Cons l -- ^ list data constructor @(:)@ | UnboxedSingleCon l -- ^ unboxed singleton tuple constructor @(\# \#)@ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | This type is used to represent qualified variables, and also -- qualified constructors. data QName l = Qual l (ModuleName l) (Name l) -- ^ name qualified with a module name | UnQual l (Name l) -- ^ unqualified local name | Special l (SpecialCon l) -- ^ built-in constructor with special syntax #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | This type is used to represent variables, and also constructors. data Name l = Ident l String -- ^ /varid/ or /conid/. | Symbol l String -- ^ /varsym/ or /consym/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An implicit parameter name. data IPName l = IPDup l String -- ^ ?/ident/, non-linear implicit parameter | IPLin l String -- ^ %/ident/, linear implicit parameter #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Possibly qualified infix operators (/qop/), appearing in expressions. data QOp l = QVarOp l (QName l) -- ^ variable operator (/qvarop/) | QConOp l (QName l) -- ^ constructor operator (/qconop/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Operators appearing in @infix@ declarations are never qualified. data Op l = VarOp l (Name l) -- ^ variable operator (/varop/) | ConOp l (Name l) -- ^ constructor operator (/conop/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A name (/cname/) of a component of a class or data type in an @import@ -- or export specification. data CName l = VarName l (Name l) -- ^ name of a method or field | ConName l (Name l) -- ^ name of a data constructor #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A complete Haskell source module. data Module l = Module l (Maybe (ModuleHead l)) [ModulePragma l] [ImportDecl l] [Decl l] -- ^ an ordinary Haskell module | XmlPage l (ModuleName l) [ModulePragma l] (XName l) [XAttr l] (Maybe (Exp l)) [Exp l] -- ^ a module consisting of a single XML document. The ModuleName never appears in the source -- but is needed for semantic purposes, it will be the same as the file name. | XmlHybrid l (Maybe (ModuleHead l)) [ModulePragma l] [ImportDecl l] [Decl l] (XName l) [XAttr l] (Maybe (Exp l)) [Exp l] -- ^ a hybrid module combining an XML document with an ordinary module #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | The head of a module, including the name and export specification. data ModuleHead l = ModuleHead l (ModuleName l) (Maybe (WarningText l)) (Maybe (ExportSpecList l)) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An explicit export specification. data ExportSpecList l = ExportSpecList l [ExportSpec l] #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An item in a module's export specification. data ExportSpec l = EVar l (QName l) -- ^ variable | EAbs l (QName l) -- ^ @T@: -- a class or datatype exported abstractly, -- or a type synonym. | EThingAll l (QName l) -- ^ @T(..)@: -- a class exported with all of its methods, or -- a datatype exported with all of its constructors. | EThingWith l (QName l) [CName l] -- ^ @T(C_1,...,C_n)@: -- a class exported with some of its methods, or -- a datatype exported with some of its constructors. | EModuleContents l (ModuleName l) -- ^ @module M@: -- re-export a module. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An import declaration. data ImportDecl l = ImportDecl { importAnn :: l -- ^ annotation, used by parser for position of the @import@ keyword. , importModule :: (ModuleName l) -- ^ name of the module imported. , importQualified :: Bool -- ^ imported @qualified@? , importSrc :: Bool -- ^ imported with @{-\# SOURCE \#-}@? , importPkg :: Maybe String -- ^ imported with explicit package name , importAs :: Maybe (ModuleName l) -- ^ optional alias name in an @as@ clause. , importSpecs :: Maybe (ImportSpecList l) -- ^ optional list of import specifications. } #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An explicit import specification list. data ImportSpecList l = ImportSpecList l Bool [ImportSpec l] -- A list of import specifications. -- The 'Bool' is 'True' if the names are excluded -- by @hiding@. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An import specification, representing a single explicit item imported -- (or hidden) from a module. data ImportSpec l = IVar l (Name l) -- ^ variable | IAbs l (Name l) -- ^ @T@: -- the name of a class, datatype or type synonym. | IThingAll l (Name l) -- ^ @T(..)@: -- a class imported with all of its methods, or -- a datatype imported with all of its constructors. | IThingWith l (Name l) [CName l] -- ^ @T(C_1,...,C_n)@: -- a class imported with some of its methods, or -- a datatype imported with some of its constructors. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Associativity of an operator. data Assoc l = AssocNone l -- ^ non-associative operator (declared with @infix@) | AssocLeft l -- ^ left-associative operator (declared with @infixl@). | AssocRight l -- ^ right-associative operator (declared with @infixr@) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A top-level declaration. data Decl l = TypeDecl l (DeclHead l) (Type l) -- ^ A type declaration | TypeFamDecl l (DeclHead l) (Maybe (Kind l)) -- ^ A type family declaration | DataDecl l (DataOrNew l) (Maybe (Context l)) (DeclHead l) [QualConDecl l] (Maybe (Deriving l)) -- ^ A data OR newtype declaration | GDataDecl l (DataOrNew l) (Maybe (Context l)) (DeclHead l) (Maybe (Kind l)) [GadtDecl l] (Maybe (Deriving l)) -- ^ A data OR newtype declaration, GADT style | DataFamDecl l {-data-} (Maybe (Context l)) (DeclHead l) (Maybe (Kind l)) -- ^ A data family declaration | TypeInsDecl l (Type l) (Type l) -- ^ A type family instance declaration | DataInsDecl l (DataOrNew l) (Type l) [QualConDecl l] (Maybe (Deriving l)) -- ^ A data family instance declaration | GDataInsDecl l (DataOrNew l) (Type l) (Maybe (Kind l)) [GadtDecl l] (Maybe (Deriving l)) -- ^ A data family instance declaration, GADT style | ClassDecl l (Maybe (Context l)) (DeclHead l) [FunDep l] (Maybe [ClassDecl l]) -- ^ A declaration of a type class | InstDecl l (Maybe (Context l)) (InstHead l) (Maybe [InstDecl l]) -- ^ An declaration of a type class instance | DerivDecl l (Maybe (Context l)) (InstHead l) -- ^ A standalone deriving declaration | InfixDecl l (Assoc l) (Maybe Int) [Op l] -- ^ A declaration of operator fixity | DefaultDecl l [Type l] -- ^ A declaration of default types | SpliceDecl l (Exp l) -- ^ A Template Haskell splicing declaration | TypeSig l [Name l] (Type l) -- ^ A type signature declaration | FunBind l [Match l] -- ^ A set of function binding clauses | PatBind l (Pat l) (Maybe (Type l)) (Rhs l) {-where-} (Maybe (Binds l)) -- ^ A pattern binding | ForImp l (CallConv l) (Maybe (Safety l)) (Maybe String) (Name l) (Type l) -- ^ A foreign import declaration | ForExp l (CallConv l) (Maybe String) (Name l) (Type l) -- ^ A foreign export declaration | RulePragmaDecl l [Rule l] -- ^ A RULES pragma | DeprPragmaDecl l [([Name l], String)] -- ^ A DEPRECATED pragma | WarnPragmaDecl l [([Name l], String)] -- ^ A WARNING pragma | InlineSig l Bool (Maybe (Activation l)) (QName l) -- ^ An INLINE pragma | InlineConlikeSig l (Maybe (Activation l)) (QName l) -- ^ An INLINE CONLIKE pragma | SpecSig l (Maybe (Activation l)) (QName l) [Type l] -- ^ A SPECIALISE pragma | SpecInlineSig l Bool (Maybe (Activation l)) (QName l) [Type l] -- ^ A SPECIALISE INLINE pragma | InstSig l (Maybe (Context l)) (InstHead l) -- ^ A SPECIALISE instance pragma | AnnPragma l (Annotation l) -- ^ An ANN pragma #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An annotation through an ANN pragma. data Annotation l = Ann l (Name l) (Exp l) -- ^ An annotation for a declared name. | TypeAnn l (Name l) (Exp l) -- ^ An annotation for a declared type. | ModuleAnn l (Exp l) -- ^ An annotation for the defining module. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A flag stating whether a declaration is a data or newtype declaration. data DataOrNew l = DataType l | NewType l #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | The head of a type or class declaration. data DeclHead l = DHead l (Name l) [TyVarBind l] | DHInfix l (TyVarBind l) (Name l) (TyVarBind l) | DHParen l (DeclHead l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | The head of an instance declaration. data InstHead l = IHead l (QName l) [Type l] | IHInfix l (Type l) (QName l) (Type l) | IHParen l (InstHead l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A deriving clause following a data type declaration. data Deriving l = Deriving l [InstHead l] #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A binding group inside a @let@ or @where@ clause. data Binds l = BDecls l [Decl l] -- ^ An ordinary binding group | IPBinds l [IPBind l] -- ^ A binding group for implicit parameters #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A binding of an implicit parameter. data IPBind l = IPBind l (IPName l) (Exp l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Clauses of a function binding. data Match l = Match l (Name l) [Pat l] (Rhs l) {-where-} (Maybe (Binds l)) -- ^ A clause defined with prefix notation, i.e. the function name -- followed by its argument patterns, the right-hand side and an -- optional where clause. | InfixMatch l (Pat l) (Name l) [Pat l] (Rhs l) {-where-} (Maybe (Binds l)) -- ^ A clause defined with infix notation, i.e. first its first argument -- pattern, then the function name, then its following argument(s), -- the right-hand side and an optional where clause. -- Note that there can be more than two arguments to a function declared -- infix, hence the list of pattern arguments. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A single constructor declaration within a data type declaration, -- which may have an existential quantification binding. data QualConDecl l = QualConDecl l {-forall-} (Maybe [TyVarBind l]) {- . -} (Maybe (Context l)) {- => -} (ConDecl l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Declaration of an ordinary data constructor. data ConDecl l = ConDecl l (Name l) [BangType l] -- ^ ordinary data constructor | InfixConDecl l (BangType l) (Name l) (BangType l) -- ^ infix data constructor | RecDecl l (Name l) [FieldDecl l] -- ^ record constructor #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Declaration of a (list of) named field(s). data FieldDecl l = FieldDecl l [Name l] (BangType l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A single constructor declaration in a GADT data type declaration. data GadtDecl l = GadtDecl l (Name l) (Type l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Declarations inside a class declaration. data ClassDecl l = ClsDecl l (Decl l) -- ^ ordinary declaration | ClsDataFam l (Maybe (Context l)) (DeclHead l) (Maybe (Kind l)) -- ^ declaration of an associated data type | ClsTyFam l (DeclHead l) (Maybe (Kind l)) -- ^ declaration of an associated type synonym | ClsTyDef l (Type l) (Type l) -- ^ default choice for an associated type synonym #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Declarations inside an instance declaration. data InstDecl l = InsDecl l (Decl l) -- ^ ordinary declaration | InsType l (Type l) (Type l) -- ^ an associated type definition | InsData l (DataOrNew l) (Type l) [QualConDecl l] (Maybe (Deriving l)) -- ^ an associated data type implementation | InsGData l (DataOrNew l) (Type l) (Maybe (Kind l)) [GadtDecl l] (Maybe (Deriving l)) -- ^ an associated data type implemented using GADT style #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | The type of a constructor argument or field, optionally including -- a strictness annotation. data BangType l = BangedTy l (Type l) -- ^ strict component, marked with \"@!@\" | UnBangedTy l (Type l) -- ^ non-strict component | UnpackedTy l (Type l) -- ^ unboxed component, marked with an UNPACK pragma #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | The right hand side of a function or pattern binding. data Rhs l = UnGuardedRhs l (Exp l) -- ^ unguarded right hand side (/exp/) | GuardedRhss l [GuardedRhs l] -- ^ guarded right hand side (/gdrhs/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A guarded right hand side @|@ /stmts/ @=@ /exp/. -- The guard is a series of statements when using pattern guards, -- otherwise it will be a single qualifier expression. data GuardedRhs l = GuardedRhs l [Stmt l] (Exp l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A type qualified with a context. -- An unqualified type has an empty context. data Type l = TyForall l (Maybe [TyVarBind l]) (Maybe (Context l)) (Type l) -- ^ qualified type | TyFun l (Type l) (Type l) -- ^ function type | TyTuple l Boxed [Type l] -- ^ tuple type, possibly boxed | TyList l (Type l) -- ^ list syntax, e.g. [a], as opposed to [] a | TyApp l (Type l) (Type l) -- ^ application of a type constructor | TyVar l (Name l) -- ^ type variable | TyCon l (QName l) -- ^ named type or type constructor | TyParen l (Type l) -- ^ type surrounded by parentheses | TyInfix l (Type l) (QName l) (Type l) -- ^ infix type constructor | TyKind l (Type l) (Kind l) -- ^ type with explicit kind signature #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Flag denoting whether a tuple is boxed or unboxed. data Boxed = Boxed | Unboxed #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A type variable declaration, optionally with an explicit kind annotation. data TyVarBind l = KindedVar l (Name l) (Kind l) -- ^ variable binding with kind annotation | UnkindedVar l (Name l) -- ^ ordinary variable binding #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An explicit kind annotation. data Kind l = KindStar l -- ^ @*@, the kind of types | KindBang l -- ^ @!@, the kind of unboxed types | KindFn l (Kind l) (Kind l) -- ^ @->@, the kind of a type constructor | KindParen l (Kind l) -- ^ a parenthesised kind | KindVar l (Name l) -- ^ a kind variable (as-of-yet unsupported by compilers) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A functional dependency, given on the form -- l1 l2 ... ln -> r2 r3 .. rn data FunDep l = FunDep l [Name l] [Name l] #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A context is a set of assertions data Context l = CxSingle l (Asst l) | CxTuple l [Asst l] | CxParen l (Context l) | CxEmpty l #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Class assertions. -- In Haskell 98, the argument would be a /tyvar/, but this definition -- allows multiple parameters, and allows them to be /type/s. -- Also extended with support for implicit parameters and equality constraints. data Asst l = ClassA l (QName l) [Type l] -- ^ ordinary class assertion | InfixA l (Type l) (QName l) (Type l) -- ^ class assertion where the class name is given infix | IParam l (IPName l) (Type l) -- ^ implicit parameter assertion | EqualP l (Type l) (Type l) -- ^ type equality constraint #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | /literal/ -- Values of this type hold the abstract value of the literal, along with the -- precise string representation used. For example, @10@, @0o12@ and @0xa@ -- have the same value representation, but each carry a different string representation. data Literal l = Char l Char String -- ^ character literal | String l String String -- ^ string literal | Int l Integer String -- ^ integer literal | Frac l Rational String -- ^ floating point literal | PrimInt l Integer String -- ^ unboxed integer literal | PrimWord l Integer String -- ^ unboxed word literal | PrimFloat l Rational String -- ^ unboxed float literal | PrimDouble l Rational String -- ^ unboxed double literal | PrimChar l Char String -- ^ unboxed character literal | PrimString l String String -- ^ unboxed string literal #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | Haskell expressions. data Exp l = Var l (QName l) -- ^ variable | IPVar l (IPName l) -- ^ implicit parameter variable | Con l (QName l) -- ^ data constructor | Lit l (Literal l) -- ^ literal constant | InfixApp l (Exp l) (QOp l) (Exp l) -- ^ infix application | App l (Exp l) (Exp l) -- ^ ordinary application | NegApp l (Exp l) -- ^ negation expression @-/exp/@ (unary minus) | Lambda l [Pat l] (Exp l) -- ^ lambda expression | Let l (Binds l) (Exp l) -- ^ local declarations with @let@ ... @in@ ... | If l (Exp l) (Exp l) (Exp l) -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/ | Case l (Exp l) [Alt l] -- ^ @case@ /exp/ @of@ /alts/ | Do l [Stmt l] -- ^ @do@-expression: -- the last statement in the list -- should be an expression. | MDo l [Stmt l] -- ^ @mdo@-expression | Tuple l Boxed [Exp l] -- ^ tuple expression | TupleSection l Boxed [Maybe (Exp l)] -- ^ tuple section expression, e.g. @(,,3)@ | List l [Exp l] -- ^ list expression | Paren l (Exp l) -- ^ parenthesised expression | LeftSection l (Exp l) (QOp l) -- ^ left section @(@/exp/ /qop/@)@ | RightSection l (QOp l) (Exp l) -- ^ right section @(@/qop/ /exp/@)@ | RecConstr l (QName l) [FieldUpdate l] -- ^ record construction expression | RecUpdate l (Exp l) [FieldUpdate l] -- ^ record update expression | EnumFrom l (Exp l) -- ^ unbounded arithmetic sequence, -- incrementing by 1: @[from ..]@ | EnumFromTo l (Exp l) (Exp l) -- ^ bounded arithmetic sequence, -- incrementing by 1 @[from .. to]@ | EnumFromThen l (Exp l) (Exp l) -- ^ unbounded arithmetic sequence, -- with first two elements given @[from, then ..]@ | EnumFromThenTo l (Exp l) (Exp l) (Exp l) -- ^ bounded arithmetic sequence, -- with first two elements given @[from, then .. to]@ | ListComp l (Exp l) [QualStmt l] -- ^ ordinary list comprehension | ParComp l (Exp l) [[QualStmt l]] -- ^ parallel list comprehension | ExpTypeSig l (Exp l) (Type l) -- ^ expression with explicit type signature | VarQuote l (QName l) -- ^ @'x@ for template haskell reifying of expressions | TypQuote l (QName l) -- ^ @''T@ for template haskell reifying of types | BracketExp l (Bracket l) -- ^ template haskell bracket expression | SpliceExp l (Splice l) -- ^ template haskell splice expression | QuasiQuote l String String -- ^ quasi-quotaion: @[$/name/| /string/ |]@ -- Hsx | XTag l (XName l) [XAttr l] (Maybe (Exp l)) [Exp l] -- ^ xml element, with attributes and children | XETag l (XName l) [XAttr l] (Maybe (Exp l)) -- ^ empty xml element, with attributes | XPcdata l String -- ^ PCDATA child element | XExpTag l (Exp l) -- ^ escaped haskell expression inside xml | XChildTag l [Exp l] -- ^ children of an xml element -- Pragmas | CorePragma l String (Exp l) -- ^ CORE pragma | SCCPragma l String (Exp l) -- ^ SCC pragma | GenPragma l String (Int, Int) (Int, Int) (Exp l) -- ^ GENERATED pragma -- Arrows | Proc l (Pat l) (Exp l) -- ^ arrows proc: @proc@ /pat/ @->@ /exp/ | LeftArrApp l (Exp l) (Exp l) -- ^ arrow application (from left): /exp/ @-<@ /exp/ | RightArrApp l (Exp l) (Exp l) -- ^ arrow application (from right): /exp/ @>-@ /exp/ | LeftArrHighApp l (Exp l) (Exp l) -- ^ higher-order arrow application (from left): /exp/ @-<<@ /exp/ | RightArrHighApp l (Exp l) (Exp l) -- ^ higher-order arrow application (from right): /exp/ @>>-@ /exp/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | The name of an xml element or attribute, -- possibly qualified with a namespace. data XName l = XName l String -- /pat/)@ | PRPat l [RPat l] -- ^ regular list pattern | PXTag l (XName l) [PXAttr l] (Maybe (Pat l)) [Pat l] -- ^ XML element pattern | PXETag l (XName l) [PXAttr l] (Maybe (Pat l)) -- ^ XML singleton element pattern | PXPcdata l String -- ^ XML PCDATA pattern | PXPatTag l (Pat l) -- ^ XML embedded pattern | PXRPats l [RPat l] -- ^ XML regular list pattern | PExplTypeArg l (QName l) (Type l) -- ^ Explicit generics style type argument e.g. @f {| Int |} x = ...@ | PQuasiQuote l String String -- ^ quasi quote pattern: @[$/name/| /string/ |]@ | PBangPat l (Pat l) -- ^ strict (bang) pattern: @f !x = ...@ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An XML attribute in a pattern. data PXAttr l = PXAttr l (XName l) (Pat l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A regular pattern operator. data RPatOp l = RPStar l -- ^ @*@ = 0 or more | RPStarG l -- ^ @*!@ = 0 or more, greedy | RPPlus l -- ^ @+@ = 1 or more | RPPlusG l -- ^ @+!@ = 1 or more, greedy | RPOpt l -- ^ @?@ = 0 or 1 | RPOptG l -- ^ @?!@ = 0 or 1, greedy #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An entity in a regular pattern. data RPat l = RPOp l (RPat l) (RPatOp l) -- ^ operator pattern, e.g. pat* | RPEither l (RPat l) (RPat l) -- ^ choice pattern, e.g. (1 | 2) | RPSeq l [RPat l] -- ^ sequence pattern, e.g. (| 1, 2, 3 |) | RPGuard l (Pat l) [Stmt l] -- ^ guarded pattern, e.g. (| p | p < 3 |) | RPCAs l (Name l) (RPat l) -- ^ non-linear variable binding, e.g. (foo\@:(1 | 2))* | RPAs l (Name l) (RPat l) -- ^ linear variable binding, e.g. foo\@(1 | 2) | RPParen l (RPat l) -- ^ parenthesised pattern, e.g. (2*) | RPPat l (Pat l) -- ^ an ordinary pattern #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An /fpat/ in a labeled record pattern. data PatField l = PFieldPat l (QName l) (Pat l) -- ^ ordinary label-pattern pair | PFieldPun l (Name l) -- ^ record field pun | PFieldWildcard l -- ^ record field wildcard #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A statement, representing both a /stmt/ in a @do@-expression, -- an ordinary /qual/ in a list comprehension, as well as a /stmt/ -- in a pattern guard. data Stmt l = Generator l (Pat l) (Exp l) -- ^ a generator: /pat/ @<-@ /exp/ | Qualifier l (Exp l) -- ^ an /exp/ by itself: in a @do@-expression, -- an action whose result is discarded; -- in a list comprehension and pattern guard, -- a guard expression | LetStmt l (Binds l) -- ^ local bindings | RecStmt l [Stmt l] -- ^ a recursive binding group for arrows #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A general /transqual/ in a list comprehension, -- which could potentially be a transform of the kind -- enabled by TransformListComp. data QualStmt l = QualStmt l (Stmt l) -- ^ an ordinary statement | ThenTrans l (Exp l) -- ^ @then@ /exp/ | ThenBy l (Exp l) (Exp l) -- ^ @then@ /exp/ @by@ /exp/ | GroupBy l (Exp l) -- ^ @then@ @group@ @by@ /exp/ | GroupUsing l (Exp l) -- ^ @then@ @group@ @using@ /exp/ | GroupByUsing l (Exp l) (Exp l) -- ^ @then@ @group@ @by@ /exp/ @using@ /exp/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An /fbind/ in a labeled construction or update expression. data FieldUpdate l = FieldUpdate l (QName l) (Exp l) -- ^ ordinary label-expresion pair | FieldPun l (Name l) -- ^ record field pun | FieldWildcard l -- ^ record field wildcard #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | An /alt/ alternative in a @case@ expression. data Alt l = Alt l (Pat l) (GuardedAlts l) (Maybe (Binds l)) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | The right-hand sides of a @case@ alternative, -- which may be a single right-hand side or a -- set of guarded ones. data GuardedAlts l = UnGuardedAlt l (Exp l) -- ^ @->@ /exp/ | GuardedAlts l [GuardedAlt l] -- ^ /gdpat/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif -- | A guarded case alternative @|@ /stmts/ @->@ /exp/. data GuardedAlt l = GuardedAlt l [Stmt l] (Exp l) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable) #else deriving (Eq,Ord,Show) #endif ----------------------------------------------------------------------------- -- Builtin names. prelude_mod, main_mod :: l -> ModuleName l prelude_mod l = ModuleName l "Prelude" main_mod l = ModuleName l "Main" main_name :: l -> Name l main_name l = Ident l "main" unit_con_name :: l -> QName l unit_con_name l = Special l (UnitCon l) tuple_con_name :: l -> Boxed -> Int -> QName l tuple_con_name l b i = Special l (TupleCon l b (i+1)) list_cons_name :: l -> QName l list_cons_name l = Special l (Cons l) unboxed_singleton_con_name :: l -> QName l unboxed_singleton_con_name l = Special l (UnboxedSingleCon l) unit_con :: l -> Exp l unit_con l = Con l $ unit_con_name l tuple_con :: l -> Boxed -> Int -> Exp l tuple_con l b i = Con l (tuple_con_name l b i) unboxed_singleton_con :: l -> Exp l unboxed_singleton_con l = Con l (unboxed_singleton_con_name l) as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name :: l -> Name l as_name l = Ident l "as" qualified_name l = Ident l "qualified" hiding_name l = Ident l "hiding" minus_name l = Symbol l "-" bang_name l = Symbol l "!" dot_name l = Symbol l "." star_name l = Symbol l "*" export_name, safe_name, unsafe_name, threadsafe_name, stdcall_name, ccall_name, cplusplus_name, dotnet_name, jvm_name, js_name, forall_name, family_name :: l -> Name l export_name l = Ident l "export" safe_name l = Ident l "safe" unsafe_name l = Ident l "unsafe" threadsafe_name l = Ident l "threadsafe" stdcall_name l = Ident l "stdcall" ccall_name l = Ident l "ccall" cplusplus_name l = Ident l "cplusplus" dotnet_name l = Ident l "dotnet" jvm_name l = Ident l "jvm" js_name l = Ident l "js" forall_name l = Ident l "forall" family_name l = Ident l "family" unit_tycon_name, fun_tycon_name, list_tycon_name, unboxed_singleton_tycon_name :: l -> QName l unit_tycon_name l = unit_con_name l fun_tycon_name l = Special l (FunCon l) list_tycon_name l = Special l (ListCon l) unboxed_singleton_tycon_name l = Special l (UnboxedSingleCon l) tuple_tycon_name :: l -> Boxed -> Int -> QName l tuple_tycon_name l b i = tuple_con_name l b i unit_tycon, fun_tycon, list_tycon, unboxed_singleton_tycon :: l -> Type l unit_tycon l = TyCon l $ unit_tycon_name l fun_tycon l = TyCon l $ fun_tycon_name l list_tycon l = TyCon l $ list_tycon_name l unboxed_singleton_tycon l = TyCon l $ unboxed_singleton_tycon_name l tuple_tycon :: l -> Boxed -> Int -> Type l tuple_tycon l b i = TyCon l (tuple_tycon_name l b i) ----------------------------------------------------------------------------- -- AST traversal, boiler-plate style -- | Test if two AST elements are equal modulo annotations. (=~=) :: (Annotated a, Eq (a ())) => a l1 -> a l2 -> Bool a =~= b = fmap (const ()) a == fmap (const ()) b instance Functor ModuleName where fmap f (ModuleName l s) = ModuleName (f l) s instance Functor SpecialCon where fmap f sc = case sc of UnitCon l -> UnitCon (f l) ListCon l -> ListCon (f l) FunCon l -> FunCon (f l) TupleCon l b n -> TupleCon (f l) b n Cons l -> Cons (f l) UnboxedSingleCon l -> UnboxedSingleCon (f l) instance Functor QName where fmap f qn = case qn of Qual l mn n -> Qual (f l) (fmap f mn) (fmap f n) UnQual l n -> UnQual (f l) (fmap f n) Special l sc -> Special (f l) (fmap f sc) instance Functor Name where fmap f (Ident l s) = Ident (f l) s fmap f (Symbol l s) = Symbol (f l) s instance Functor IPName where fmap f (IPDup l s) = IPDup (f l) s fmap f (IPLin l s) = IPLin (f l) s instance Functor QOp where fmap f (QVarOp l qn) = QVarOp (f l) (fmap f qn) fmap f (QConOp l qn) = QConOp (f l) (fmap f qn) instance Functor Op where fmap f (VarOp l n) = VarOp (f l) (fmap f n) fmap f (ConOp l n) = ConOp (f l) (fmap f n) instance Functor CName where fmap f (VarName l n) = VarName (f l) (fmap f n) fmap f (ConName l n) = ConName (f l) (fmap f n) instance Functor Module where fmap f (Module l mmh ops iss dcls) = Module (f l) (fmap (fmap f) mmh) (map (fmap f) ops) (map (fmap f) iss) (map (fmap f) dcls) fmap f (XmlPage l mn os xn xas me es) = XmlPage (f l) (fmap f mn) (map (fmap f) os) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es) fmap f (XmlHybrid l mmh ops iss dcls xn xas me es) = XmlHybrid (f l) (fmap (fmap f) mmh) (map (fmap f) ops) (map (fmap f) iss) (map (fmap f) dcls) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es) instance Functor ModuleHead where fmap f (ModuleHead l mn mwt mexpl) = ModuleHead (f l) (fmap f mn) (fmap (fmap f) mwt) (fmap (fmap f) mexpl) instance Functor ExportSpecList where fmap f (ExportSpecList l ess) = ExportSpecList (f l) (map (fmap f) ess) instance Functor ExportSpec where fmap f es = case es of EVar l qn -> EVar (f l) (fmap f qn) EAbs l qn -> EAbs (f l) (fmap f qn) EThingAll l qn -> EThingAll (f l) (fmap f qn) EThingWith l qn cns -> EThingWith (f l) (fmap f qn) (map (fmap f) cns) EModuleContents l mn -> EModuleContents (f l) (fmap f mn) instance Functor ImportDecl where fmap f (ImportDecl l mn qual src pkg mmn mis) = ImportDecl (f l) (fmap f mn) qual src pkg (fmap (fmap f) mmn) (fmap (fmap f) mis) instance Functor ImportSpecList where fmap f (ImportSpecList l b iss) = ImportSpecList (f l) b (map (fmap f) iss) instance Functor ImportSpec where fmap f is = case is of IVar l n -> IVar (f l) (fmap f n) IAbs l n -> IAbs (f l) (fmap f n) IThingAll l n -> IThingAll (f l) (fmap f n) IThingWith l n cns -> IThingWith (f l) (fmap f n) (map (fmap f) cns) instance Functor Assoc where fmap f (AssocNone l) = AssocNone (f l) fmap f (AssocLeft l) = AssocLeft (f l) fmap f (AssocRight l) = AssocRight (f l) instance Functor Decl where fmap f decl = case decl of TypeDecl l dh t -> TypeDecl (f l) (fmap f dh) (fmap f t) TypeFamDecl l dh mk -> TypeFamDecl (f l) (fmap f dh) (fmap (fmap f) mk) DataDecl l dn mcx dh cds ders -> DataDecl (f l) (fmap f dn) (fmap (fmap f) mcx) (fmap f dh) (map (fmap f) cds) (fmap (fmap f) ders) GDataDecl l dn mcx dh mk gds ders -> GDataDecl (f l) (fmap f dn) (fmap (fmap f) mcx) (fmap f dh) (fmap (fmap f) mk) (map (fmap f) gds) (fmap (fmap f) ders) DataFamDecl l mcx dh mk -> DataFamDecl (f l) (fmap (fmap f) mcx) (fmap f dh) (fmap (fmap f) mk) TypeInsDecl l t1 t2 -> TypeInsDecl (f l) (fmap f t1) (fmap f t2) DataInsDecl l dn t cds ders -> DataInsDecl (f l) (fmap f dn) (fmap f t) (map (fmap f) cds) (fmap (fmap f) ders) GDataInsDecl l dn t mk gds ders -> GDataInsDecl (f l) (fmap f dn) (fmap f t) (fmap (fmap f) mk) (map (fmap f) gds) (fmap (fmap f) ders) ClassDecl l mcx dh fds mcds -> ClassDecl (f l) (fmap (fmap f) mcx) (fmap f dh) (map (fmap f) fds) (fmap (map (fmap f)) mcds) InstDecl l mcx ih mids -> InstDecl (f l) (fmap (fmap f) mcx) (fmap f ih) (fmap (map (fmap f)) mids) DerivDecl l mcx ih -> DerivDecl (f l) (fmap (fmap f) mcx) (fmap f ih) InfixDecl l a k ops -> InfixDecl (f l) (fmap f a) k (map (fmap f) ops) DefaultDecl l ts -> DefaultDecl (f l) (map (fmap f) ts) SpliceDecl l sp -> SpliceDecl (f l) (fmap f sp) TypeSig l ns t -> TypeSig (f l) (map (fmap f) ns) (fmap f t) FunBind l ms -> FunBind (f l) (map (fmap f) ms) PatBind l p mt rhs bs -> PatBind (f l) (fmap f p) (fmap (fmap f) mt) (fmap f rhs) (fmap (fmap f) bs) ForImp l cc msf s n t -> ForImp (f l) (fmap f cc) (fmap (fmap f) msf) s (fmap f n) (fmap f t) ForExp l cc s n t -> ForExp (f l) (fmap f cc) s (fmap f n) (fmap f t) RulePragmaDecl l rs -> RulePragmaDecl (f l) (map (fmap f) rs) DeprPragmaDecl l nss -> DeprPragmaDecl (f l) (map (wp f) nss) WarnPragmaDecl l nss -> WarnPragmaDecl (f l) (map (wp f) nss) InlineSig l b mact qn -> InlineSig (f l) b (fmap (fmap f) mact) (fmap f qn) InlineConlikeSig l mact qn -> InlineConlikeSig (f l) (fmap (fmap f) mact) (fmap f qn) SpecInlineSig l b mact qn ts -> SpecInlineSig (f l) b (fmap (fmap f) mact) (fmap f qn) (map (fmap f) ts) SpecSig l mact qn ts -> SpecSig (f l) (fmap (fmap f) mact) (fmap f qn) (map (fmap f) ts) InstSig l mcx ih -> InstSig (f l) (fmap (fmap f) mcx) (fmap f ih) AnnPragma l ann -> AnnPragma (f l) (fmap f ann) where wp f (ns, s) = (map (fmap f) ns, s) instance Functor Annotation where fmap f (Ann l n e) = Ann (f l) (fmap f n) (fmap f e) fmap f (TypeAnn l n e) = TypeAnn (f l) (fmap f n) (fmap f e) fmap f (ModuleAnn l e) = ModuleAnn (f l) (fmap f e) instance Functor DataOrNew where fmap f (DataType l) = DataType (f l) fmap f (NewType l) = NewType (f l) instance Functor DeclHead where fmap f (DHead l n tvs) = DHead (f l) (fmap f n) (map (fmap f) tvs) fmap f (DHInfix l tva n tvb) = DHInfix (f l) (fmap f tva) (fmap f n) (fmap f tvb) fmap f (DHParen l dh) = DHParen (f l) (fmap f dh) instance Functor InstHead where fmap f (IHead l qn ts) = IHead (f l) (fmap f qn) (map (fmap f) ts) fmap f (IHInfix l ta qn tb) = IHInfix (f l) (fmap f ta) (fmap f qn) (fmap f tb) fmap f (IHParen l ih) = IHParen (f l) (fmap f ih) instance Functor Deriving where fmap f (Deriving l ihs) = Deriving (f l) (map (fmap f) ihs) instance Functor Binds where fmap f (BDecls l decls) = BDecls (f l) (map (fmap f) decls) fmap f (IPBinds l ibs) = IPBinds (f l) (map (fmap f) ibs) instance Functor IPBind where fmap f (IPBind l ipn e) = IPBind (f l) (fmap f ipn) (fmap f e) instance Functor Match where fmap f (Match l n ps rhs bs) = Match (f l) (fmap f n) (map (fmap f) ps) (fmap f rhs) (fmap (fmap f) bs) fmap f (InfixMatch l a n ps rhs bs) = InfixMatch (f l) (fmap f a) (fmap f n) (map (fmap f) ps) (fmap f rhs) (fmap (fmap f) bs) instance Functor QualConDecl where fmap f (QualConDecl l mtvs mcx cd) = QualConDecl (f l) (fmap (map (fmap f)) mtvs) (fmap (fmap f) mcx) (fmap f cd) instance Functor ConDecl where fmap f (ConDecl l n bts) = ConDecl (f l) (fmap f n) (map (fmap f) bts) fmap f (InfixConDecl l ta n tb) = InfixConDecl (f l) (fmap f ta) (fmap f n) (fmap f tb) fmap f (RecDecl l n fds) = RecDecl (f l) (fmap f n) (map (fmap f) fds) instance Functor FieldDecl where fmap f (FieldDecl l ns t) = FieldDecl (f l) (map (fmap f) ns) (fmap f t) instance Functor GadtDecl where fmap f (GadtDecl l n t) = GadtDecl (f l) (fmap f n) (fmap f t) instance Functor ClassDecl where fmap f (ClsDecl l d) = ClsDecl (f l) (fmap f d) fmap f (ClsDataFam l mcx dh mk) = ClsDataFam (f l) (fmap (fmap f) mcx) (fmap f dh) (fmap (fmap f) mk) fmap f (ClsTyFam l dh mk) = ClsTyFam (f l) (fmap f dh) (fmap (fmap f) mk) fmap f (ClsTyDef l t1 t2) = ClsTyDef (f l) (fmap f t1) (fmap f t2) instance Functor InstDecl where fmap f id = case id of InsDecl l d -> InsDecl (f l) (fmap f d) InsType l t1 t2 -> InsType (f l) (fmap f t1) (fmap f t2) InsData l dn t cds ders -> InsData (f l) (fmap f dn) (fmap f t) (map (fmap f) cds) (fmap (fmap f) ders) InsGData l dn t mk gds ders -> InsGData (f l) (fmap f dn) (fmap f t) (fmap (fmap f) mk) (map (fmap f) gds) (fmap (fmap f) ders) -- InsInline l b mact qn -> InsInline (f l) b (fmap (fmap f) mact) (fmap f qn) instance Functor BangType where fmap f (BangedTy l t) = BangedTy (f l) (fmap f t) fmap f (UnBangedTy l t) = UnBangedTy (f l) (fmap f t) fmap f (UnpackedTy l t) = UnpackedTy (f l) (fmap f t) instance Functor Rhs where fmap f (UnGuardedRhs l e) = UnGuardedRhs (f l) (fmap f e) fmap f (GuardedRhss l grhss) = GuardedRhss (f l) (map (fmap f) grhss) instance Functor GuardedRhs where fmap f (GuardedRhs l ss e) = GuardedRhs (f l) (map (fmap f) ss) (fmap f e) instance Functor Type where fmap f t = case t of TyForall l mtvs mcx t -> TyForall (f l) (fmap (map (fmap f)) mtvs) (fmap (fmap f) mcx) (fmap f t) TyFun l t1 t2 -> TyFun (f l) (fmap f t1) (fmap f t2) TyTuple l b ts -> TyTuple (f l) b (map (fmap f) ts) TyList l t -> TyList (f l) (fmap f t) TyApp l t1 t2 -> TyApp (f l) (fmap f t1) (fmap f t2) TyVar l n -> TyVar (f l) (fmap f n) TyCon l qn -> TyCon (f l) (fmap f qn) TyParen l t -> TyParen (f l) (fmap f t) TyInfix l ta qn tb -> TyInfix (f l) (fmap f ta) (fmap f qn) (fmap f tb) TyKind l t k -> TyKind (f l) (fmap f t) (fmap f k) instance Functor TyVarBind where fmap f (KindedVar l n k) = KindedVar (f l) (fmap f n) (fmap f k) fmap f (UnkindedVar l n) = UnkindedVar (f l) (fmap f n) instance Functor Kind where fmap f (KindStar l) = KindStar (f l) fmap f (KindBang l) = KindBang (f l) fmap f (KindFn l k1 k2) = KindFn (f l) (fmap f k1) (fmap f k2) fmap f (KindParen l k) = KindParen (f l) (fmap f k) fmap f (KindVar l n) = KindVar (f l) (fmap f n) instance Functor FunDep where fmap f (FunDep l ns1 ns2) = FunDep (f l) (map (fmap f) ns1) (map (fmap f) ns2) instance Functor Context where fmap f (CxSingle l asst) = CxSingle (f l) (fmap f asst) fmap f (CxTuple l assts) = CxTuple (f l) (map (fmap f) assts) fmap f (CxParen l ctxt) = CxParen (f l) (fmap f ctxt) fmap f (CxEmpty l) = CxEmpty (f l) instance Functor Asst where fmap f asst = case asst of ClassA l qn ts -> ClassA (f l) (fmap f qn) (map (fmap f) ts) InfixA l ta qn tb -> InfixA (f l) (fmap f ta) (fmap f qn) (fmap f tb) IParam l ipn t -> IParam (f l) (fmap f ipn) (fmap f t) EqualP l t1 t2 -> EqualP (f l) (fmap f t1) (fmap f t2) instance Functor Literal where fmap f lit = case lit of Char l c rw -> Char (f l) c rw String l s rw -> String (f l) s rw Int l i rw -> Int (f l) i rw Frac l r rw -> Frac (f l) r rw PrimInt l i rw -> PrimInt (f l) i rw PrimWord l i rw -> PrimWord (f l) i rw PrimFloat l r rw -> PrimFloat (f l) r rw PrimDouble l r rw -> PrimDouble (f l) r rw PrimChar l c rw -> PrimChar (f l) c rw PrimString l s rw -> PrimString (f l) s rw instance Functor Exp where fmap f e = case e of Var l qn -> Var (f l) (fmap f qn) IPVar l ipn -> IPVar (f l) (fmap f ipn) Con l qn -> Con (f l) (fmap f qn) Lit l lit -> Lit (f l) (fmap f lit) InfixApp l e1 qop e2 -> InfixApp (f l) (fmap f e1) (fmap f qop) (fmap f e2) App l e1 e2 -> App (f l) (fmap f e1) (fmap f e2) NegApp l e -> NegApp (f l) (fmap f e) Lambda l ps e -> Lambda (f l) (map (fmap f) ps) (fmap f e) Let l bs e -> Let (f l) (fmap f bs) (fmap f e) If l ec et ee -> If (f l) (fmap f ec) (fmap f et) (fmap f ee) Case l e alts -> Case (f l) (fmap f e) (map (fmap f) alts) Do l ss -> Do (f l) (map (fmap f) ss) MDo l ss -> MDo (f l) (map (fmap f) ss) Tuple l bx es -> Tuple (f l) bx (map (fmap f) es) TupleSection l bx mes -> TupleSection (f l) bx (map (fmap (fmap f)) mes) List l es -> List (f l) (map (fmap f) es) Paren l e -> Paren (f l) (fmap f e) LeftSection l e qop -> LeftSection (f l) (fmap f e) (fmap f qop) RightSection l qop e -> RightSection (f l) (fmap f qop) (fmap f e) RecConstr l qn fups -> RecConstr (f l) (fmap f qn) (map (fmap f) fups) RecUpdate l e fups -> RecUpdate (f l) (fmap f e) (map (fmap f) fups) EnumFrom l e -> EnumFrom (f l) (fmap f e) EnumFromTo l ef et -> EnumFromTo (f l) (fmap f ef) (fmap f et) EnumFromThen l ef et -> EnumFromThen (f l) (fmap f ef) (fmap f et) EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) (fmap f ef) (fmap f eth) (fmap f eto) ListComp l e qss -> ListComp (f l) (fmap f e) (map (fmap f) qss) ParComp l e qsss -> ParComp (f l) (fmap f e) (map (map (fmap f)) qsss) ExpTypeSig l e t -> ExpTypeSig (f l) (fmap f e) (fmap f t) VarQuote l qn -> VarQuote (f l) (fmap f qn) TypQuote l qn -> TypQuote (f l) (fmap f qn) BracketExp l br -> BracketExp (f l) (fmap f br) SpliceExp l sp -> SpliceExp (f l) (fmap f sp) QuasiQuote l sn se -> QuasiQuote (f l) sn se XTag l xn xas me es -> XTag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es) XETag l xn xas me -> XETag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) XPcdata l s -> XPcdata (f l) s XExpTag l e -> XExpTag (f l) (fmap f e) XChildTag l es -> XChildTag (f l) (map (fmap f) es) CorePragma l s e -> CorePragma (f l) s (fmap f e) SCCPragma l s e -> SCCPragma (f l) s (fmap f e) GenPragma l s n12 n34 e -> GenPragma (f l) s n12 n34 (fmap f e) Proc l p e -> Proc (f l) (fmap f p) (fmap f e) LeftArrApp l e1 e2 -> LeftArrApp (f l) (fmap f e1) (fmap f e2) RightArrApp l e1 e2 -> RightArrApp (f l) (fmap f e1) (fmap f e2) LeftArrHighApp l e1 e2 -> LeftArrHighApp (f l) (fmap f e1) (fmap f e2) RightArrHighApp l e1 e2 -> RightArrHighApp (f l) (fmap f e1) (fmap f e2) instance Functor XName where fmap f (XName l s) = XName (f l) s fmap f (XDomName l sd sn) = XDomName (f l) sd sn instance Functor XAttr where fmap f (XAttr l xn e) = XAttr (f l) (fmap f xn) (fmap f e) instance Functor Bracket where fmap f (ExpBracket l e) = ExpBracket (f l) (fmap f e) fmap f (PatBracket l p) = PatBracket (f l) (fmap f p) fmap f (TypeBracket l t) = TypeBracket (f l) (fmap f t) fmap f (DeclBracket l ds) = DeclBracket (f l) (map (fmap f) ds) instance Functor Splice where fmap f (IdSplice l s) = IdSplice (f l) s fmap f (ParenSplice l e) = ParenSplice (f l) (fmap f e) instance Functor Safety where fmap f (PlayRisky l) = PlayRisky (f l) fmap f (PlaySafe l b) = PlaySafe (f l) b fmap f (PlayInterruptible l) = PlayInterruptible (f l) instance Functor CallConv where fmap f (StdCall l) = StdCall (f l) fmap f (CCall l) = CCall (f l) fmap f (CPlusPlus l) = CPlusPlus (f l) fmap f (DotNet l) = DotNet (f l) fmap f (Jvm l) = Jvm (f l) fmap f (Js l) = Js (f l) fmap f (CApi l) = CApi (f l) instance Functor ModulePragma where fmap f (LanguagePragma l ns) = LanguagePragma (f l) (map (fmap f) ns) fmap f (OptionsPragma l mt s) = OptionsPragma (f l) mt s fmap f (AnnModulePragma l ann) = AnnModulePragma (f l) (fmap f ann) instance Functor Activation where fmap f (ActiveFrom l k) = ActiveFrom (f l) k fmap f (ActiveUntil l k) = ActiveUntil (f l) k instance Functor Rule where fmap f (Rule l s mact mrvs e1 e2) = Rule (f l) s (fmap (fmap f) mact) (fmap (map (fmap f)) mrvs) (fmap f e1) (fmap f e2) instance Functor RuleVar where fmap f (RuleVar l n) = RuleVar (f l) (fmap f n) fmap f (TypedRuleVar l n t) = TypedRuleVar (f l) (fmap f n) (fmap f t) instance Functor WarningText where fmap f (DeprText l s) = DeprText (f l) s fmap f (WarnText l s) = WarnText (f l) s instance Functor Pat where fmap f p = case p of PVar l n -> PVar (f l) (fmap f n) PLit l lit -> PLit (f l) (fmap f lit) PNeg l p -> PNeg (f l) (fmap f p) PNPlusK l n k -> PNPlusK (f l) (fmap f n) k PInfixApp l pa qn pb -> PInfixApp (f l) (fmap f pa) (fmap f qn) (fmap f pb) PApp l qn ps -> PApp (f l) (fmap f qn) (map (fmap f) ps) PTuple l bx ps -> PTuple (f l) bx (map (fmap f) ps) PList l ps -> PList (f l) (map (fmap f) ps) PParen l p -> PParen (f l) (fmap f p) PRec l qn pfs -> PRec (f l) (fmap f qn) (map (fmap f) pfs) PAsPat l n p -> PAsPat (f l) (fmap f n) (fmap f p) PWildCard l -> PWildCard (f l) PIrrPat l p -> PIrrPat (f l) (fmap f p) PatTypeSig l p t -> PatTypeSig (f l) (fmap f p) (fmap f t) PViewPat l e p -> PViewPat (f l) (fmap f e) (fmap f p) PRPat l rps -> PRPat (f l) (map (fmap f) rps) PXTag l xn pxas mp ps -> PXTag (f l) (fmap f xn) (map (fmap f) pxas) (fmap (fmap f) mp) (map (fmap f) ps) PXETag l xn pxas mp -> PXETag (f l) (fmap f xn) (map (fmap f) pxas) (fmap (fmap f) mp) PXPcdata l s -> PXPcdata (f l) s PXPatTag l p -> PXPatTag (f l) (fmap f p) PXRPats l rps -> PXRPats (f l) (map (fmap f) rps) PExplTypeArg l qn t -> PExplTypeArg (f l) (fmap f qn) (fmap f t) PQuasiQuote l sn st -> PQuasiQuote (f l) sn st PBangPat l p -> PBangPat (f l) (fmap f p) instance Functor PXAttr where fmap f (PXAttr l xn p) = PXAttr (f l) (fmap f xn) (fmap f p) instance Functor RPatOp where fmap f (RPStar l) = RPStar (f l) fmap f (RPStarG l) = RPStarG (f l) fmap f (RPPlus l) = RPPlus (f l) fmap f (RPPlusG l) = RPPlusG (f l) fmap f (RPOpt l) = RPOpt (f l) fmap f (RPOptG l) = RPOptG (f l) instance Functor RPat where fmap f rp = case rp of RPOp l rp rop -> RPOp (f l) (fmap f rp) (fmap f rop) RPEither l rp1 rp2 -> RPEither (f l) (fmap f rp1) (fmap f rp2) RPSeq l rps -> RPSeq (f l) (map (fmap f) rps) RPGuard l p ss -> RPGuard (f l) (fmap f p) (map (fmap f) ss) RPCAs l n rp -> RPCAs (f l) (fmap f n) (fmap f rp) RPAs l n rp -> RPAs (f l) (fmap f n) (fmap f rp) RPParen l rp -> RPParen (f l) (fmap f rp) RPPat l p -> RPPat (f l) (fmap f p) instance Functor PatField where fmap f (PFieldPat l qn p) = PFieldPat (f l) (fmap f qn) (fmap f p) fmap f (PFieldPun l n) = PFieldPun (f l) (fmap f n) fmap f (PFieldWildcard l) = PFieldWildcard (f l) instance Functor Stmt where fmap f (Generator l p e) = Generator (f l) (fmap f p) (fmap f e) fmap f (Qualifier l e) = Qualifier (f l) (fmap f e) fmap f (LetStmt l bs) = LetStmt (f l) (fmap f bs) fmap f (RecStmt l ss) = RecStmt (f l) (map (fmap f) ss) instance Functor QualStmt where fmap f (QualStmt l s) = QualStmt (f l) (fmap f s) fmap f (ThenTrans l e) = ThenTrans (f l) (fmap f e) fmap f (ThenBy l e1 e2) = ThenBy (f l) (fmap f e1) (fmap f e2) fmap f (GroupBy l e) = GroupBy (f l) (fmap f e) fmap f (GroupUsing l e) = GroupUsing (f l) (fmap f e) fmap f (GroupByUsing l e1 e2) = GroupByUsing (f l) (fmap f e1) (fmap f e2) instance Functor FieldUpdate where fmap f (FieldUpdate l qn e) = FieldUpdate (f l) (fmap f qn) (fmap f e) fmap f (FieldPun l n) = FieldPun (f l) (fmap f n) fmap f (FieldWildcard l) = FieldWildcard (f l) instance Functor Alt where fmap f (Alt l p gs bs) = Alt (f l) (fmap f p) (fmap f gs) (fmap (fmap f) bs) instance Functor GuardedAlts where fmap f (UnGuardedAlt l e) = UnGuardedAlt (f l) (fmap f e) fmap f (GuardedAlts l galts) = GuardedAlts (f l) (map (fmap f) galts) instance Functor GuardedAlt where fmap f (GuardedAlt l ss e) = GuardedAlt (f l) (map (fmap f) ss) (fmap f e) ----------------------------------------------------------------------------- -- Reading annotations -- | AST nodes are annotated, and this class allows manipulation of the annotations. class Functor ast => Annotated ast where -- | Retrieve the annotation of an AST node. ann :: ast l -> l -- | Change the annotation of an AST node. Note that only the annotation of -- the node itself is affected, and not the annotations of any child nodes. -- if all nodes in the AST tree are to be affected, use 'fmap'. amap :: (l -> l) -> ast l -> ast l instance Annotated ModuleName where ann (ModuleName l _) = l amap f (ModuleName l n) = ModuleName (f l) n instance Annotated SpecialCon where ann sc = case sc of UnitCon l -> l ListCon l -> l FunCon l -> l TupleCon l _ _ -> l Cons l -> l UnboxedSingleCon l -> l amap = fmap instance Annotated QName where ann qn = case qn of Qual l mn n -> l UnQual l n -> l Special l sc -> l amap f qn = case qn of Qual l mn n -> Qual (f l) mn n UnQual l n -> UnQual (f l) n Special l sc -> Special (f l) sc instance Annotated Name where ann (Ident l s) = l ann (Symbol l s) = l amap = fmap instance Annotated IPName where ann (IPDup l s) = l ann (IPLin l s) = l amap = fmap instance Annotated QOp where ann (QVarOp l qn) = l ann (QConOp l qn) = l amap f (QVarOp l qn) = QVarOp (f l) qn amap f (QConOp l qn) = QConOp (f l) qn instance Annotated Op where ann (VarOp l n) = l ann (ConOp l n) = l amap f (VarOp l n) = VarOp (f l) n amap f (ConOp l n) = ConOp (f l) n instance Annotated CName where ann (VarName l n) = l ann (ConName l n) = l amap f (VarName l n) = VarName (f l) n amap f (ConName l n) = ConName (f l) n instance Annotated Module where ann (Module l mmh ops iss dcls) = l ann (XmlPage l mn os xn xas me es) = l ann (XmlHybrid l mmh ops iss dcls xn xas me es) = l amap f (Module l mmh ops iss dcls) = Module (f l) mmh ops iss dcls amap f (XmlPage l mn os xn xas me es) = XmlPage (f l) mn os xn xas me es amap f (XmlHybrid l mmh ops iss dcls xn xas me es) = XmlHybrid (f l) mmh ops iss dcls xn xas me es instance Annotated ModuleHead where ann (ModuleHead l n mwt mesl) = l amap f (ModuleHead l n mwt mesl) = ModuleHead (f l) n mwt mesl instance Annotated ExportSpecList where ann (ExportSpecList l ess) = l amap f (ExportSpecList l ess) = ExportSpecList (f l) ess instance Annotated ExportSpec where ann es = case es of EVar l qn -> l EAbs l qn -> l EThingAll l qn -> l EThingWith l qn cns -> l EModuleContents l mn -> l amap f es = case es of EVar l qn -> EVar (f l) qn EAbs l qn -> EAbs (f l) qn EThingAll l qn -> EThingAll (f l) qn EThingWith l qn cns -> EThingWith (f l) qn cns EModuleContents l mn -> EModuleContents (f l) mn instance Annotated ImportDecl where ann (ImportDecl l mn qual src pkg mmn mis) = l amap f (ImportDecl l mn qual src pkg mmn mis) = ImportDecl (f l) mn qual src pkg mmn mis instance Annotated ImportSpecList where ann (ImportSpecList l b iss) = l amap f (ImportSpecList l b iss) = ImportSpecList (f l) b iss instance Annotated ImportSpec where ann is = case is of IVar l n -> l IAbs l n -> l IThingAll l n -> l IThingWith l n cns -> l amap f is = case is of IVar l n -> IVar (f l) n IAbs l n -> IAbs (f l) n IThingAll l n -> IThingAll (f l) n IThingWith l n cns -> IThingWith (f l) n cns instance Annotated Assoc where ann (AssocNone l) = l ann (AssocLeft l) = l ann (AssocRight l) = l amap = fmap instance Annotated Deriving where ann (Deriving l ihs) = l amap f (Deriving l ihs) = Deriving (f l) ihs instance Annotated Decl where ann decl = case decl of TypeDecl l dh t -> l TypeFamDecl l dh mk -> l DataDecl l dn cx dh cds ders -> l GDataDecl l dn cx dh mk gds ders -> l DataFamDecl l cx dh mk -> l TypeInsDecl l t1 t2 -> l DataInsDecl l dn t cds ders -> l GDataInsDecl l dn t mk gds ders -> l ClassDecl l cx dh fds cds -> l InstDecl l cx ih ids -> l DerivDecl l cx ih -> l InfixDecl l a k ops -> l DefaultDecl l ts -> l SpliceDecl l sp -> l TypeSig l ns t -> l FunBind l ms -> l PatBind l p mt rhs bs -> l ForImp l cc msf s n t -> l ForExp l cc s n t -> l RulePragmaDecl l rs -> l DeprPragmaDecl l nss -> l WarnPragmaDecl l nss -> l InlineSig l b act qn -> l InlineConlikeSig l act qn -> l SpecSig l act qn ts -> l SpecInlineSig l b act qn ts -> l InstSig l cx ih -> l AnnPragma l ann -> l amap f decl = case decl of TypeDecl l dh t -> TypeDecl (f l) dh t TypeFamDecl l dh mk -> TypeFamDecl (f l) dh mk DataDecl l dn mcx dh cds ders -> DataDecl (f l) dn mcx dh cds ders GDataDecl l dn mcx dh mk gds ders -> GDataDecl (f l) dn mcx dh mk gds ders DataFamDecl l mcx dh mk -> DataFamDecl (f l) mcx dh mk TypeInsDecl l t1 t2 -> TypeInsDecl (f l) t1 t2 DataInsDecl l dn t cds ders -> DataInsDecl (f l) dn t cds ders GDataInsDecl l dn t mk gds ders -> GDataInsDecl (f l) dn t mk gds ders ClassDecl l mcx dh fds cds -> ClassDecl (f l) mcx dh fds cds InstDecl l mcx ih ids -> InstDecl (f l) mcx ih ids DerivDecl l mcx ih -> DerivDecl (f l) mcx ih InfixDecl l a k ops -> InfixDecl (f l) a k ops DefaultDecl l ts -> DefaultDecl (f l) ts SpliceDecl l sp -> SpliceDecl (f l) sp TypeSig l ns t -> TypeSig (f l) ns t FunBind l ms -> FunBind (f l) ms PatBind l p mt rhs bs -> PatBind (f l) p mt rhs bs ForImp l cc msf s n t -> ForImp (f l) cc msf s n t ForExp l cc s n t -> ForExp (f l) cc s n t RulePragmaDecl l rs -> RulePragmaDecl (f l) rs DeprPragmaDecl l nss -> DeprPragmaDecl (f l) nss WarnPragmaDecl l nss -> WarnPragmaDecl (f l) nss InlineSig l b act qn -> InlineSig (f l) b act qn InlineConlikeSig l act qn -> InlineConlikeSig (f l) act qn SpecSig l act qn ts -> SpecSig (f l) act qn ts SpecInlineSig l b act qn ts -> SpecInlineSig (f l) b act qn ts InstSig l mcx ih -> InstSig (f l) mcx ih AnnPragma l ann -> AnnPragma (f l) ann instance Annotated Annotation where ann (Ann l n e) = l ann (TypeAnn l n e) = l ann (ModuleAnn l e) = l amap f (Ann l n e) = Ann (f l) n e amap f (TypeAnn l n e) = TypeAnn (f l) n e amap f (ModuleAnn l e) = ModuleAnn (f l) e instance Annotated DataOrNew where ann (DataType l) = l ann (NewType l) = l amap = fmap instance Annotated DeclHead where ann (DHead l n tvs) = l ann (DHInfix l tva n tvb) = l ann (DHParen l dh) = l amap f (DHead l n tvs) = DHead (f l) n tvs amap f (DHInfix l tva n tvb) = DHInfix (f l) tva n tvb amap f (DHParen l dh) = DHParen (f l) dh instance Annotated InstHead where ann (IHead l qn ts) = l ann (IHInfix l ta qn tb) = l ann (IHParen l ih) = l amap f (IHead l qn ts) = IHead (f l) qn ts amap f (IHInfix l ta qn tb) = IHInfix (f l) ta qn tb amap f (IHParen l ih) = IHParen (f l) ih instance Annotated Binds where ann (BDecls l decls) = l ann (IPBinds l ibs) = l amap f (BDecls l decls) = BDecls (f l) decls amap f (IPBinds l ibs) = IPBinds (f l) ibs instance Annotated IPBind where ann (IPBind l ipn e) = l amap f (IPBind l ipn e) = IPBind (f l) ipn e instance Annotated Match where ann (Match l n ps rhs bs) = l ann (InfixMatch l a n b rhs bs) = l amap f (Match l n ps rhs bs) = Match (f l) n ps rhs bs amap f (InfixMatch l a n b rhs bs) = InfixMatch (f l) a n b rhs bs instance Annotated QualConDecl where ann (QualConDecl l tvs cx cd) = l amap f (QualConDecl l tvs cx cd) = QualConDecl (f l) tvs cx cd instance Annotated ConDecl where ann (ConDecl l n bts) = l ann (InfixConDecl l ta n tb) = l ann (RecDecl l n nsbts) = l amap f (ConDecl l n bts) = ConDecl (f l) n bts amap f (InfixConDecl l ta n tb) = InfixConDecl (f l) ta n tb amap f (RecDecl l n fds) = RecDecl (f l) n fds instance Annotated FieldDecl where ann (FieldDecl l ns t) = l amap f (FieldDecl l ns t) = FieldDecl (f l) ns t instance Annotated GadtDecl where ann (GadtDecl l n t) = l amap f (GadtDecl l n t) = GadtDecl (f l) n t instance Annotated ClassDecl where ann (ClsDecl l d) = l ann (ClsDataFam l cx dh mk) = l ann (ClsTyFam l dh mk) = l ann (ClsTyDef l t1 t2) = l amap f (ClsDecl l d) = ClsDecl (f l) d amap f (ClsDataFam l mcx dh mk) = ClsDataFam (f l) mcx dh mk amap f (ClsTyFam l dh mk) = ClsTyFam (f l) dh mk amap f (ClsTyDef l t1 t2) = ClsTyDef (f l) t1 t2 instance Annotated InstDecl where ann id = case id of InsDecl l d -> l InsType l t1 t2 -> l InsData l dn t cds ders -> l InsGData l dn t mk gds ders -> l -- InsInline l b act qn -> l amap f id = case id of InsDecl l d -> InsDecl (f l) d InsType l t1 t2 -> InsType (f l) t1 t2 InsData l dn t cds ders -> InsData (f l) dn t cds ders InsGData l dn t mk gds ders -> InsGData (f l) dn t mk gds ders -- InsInline l b act qn -> InsInline (f l) b act qn instance Annotated BangType where ann (BangedTy l t) = l ann (UnBangedTy l t) = l ann (UnpackedTy l t) = l amap f (BangedTy l t) = BangedTy (f l) t amap f (UnBangedTy l t) = UnBangedTy (f l) t amap f (UnpackedTy l t) = UnpackedTy (f l) t instance Annotated Rhs where ann (UnGuardedRhs l e) = l ann (GuardedRhss l grhss) = l amap f (UnGuardedRhs l e) = UnGuardedRhs (f l) e amap f (GuardedRhss l grhss) = GuardedRhss (f l) grhss instance Annotated GuardedRhs where ann (GuardedRhs l ss e) = l amap f (GuardedRhs l ss e) = GuardedRhs (f l) ss e instance Annotated Type where ann t = case t of TyForall l mtvs cx t -> l TyFun l t1 t2 -> l TyTuple l b ts -> l TyList l t -> l TyApp l t1 t2 -> l TyVar l n -> l TyCon l qn -> l TyParen l t -> l TyInfix l ta qn tb -> l TyKind l t k -> l amap f t = case t of TyForall l mtvs mcx t -> TyForall (f l) mtvs mcx t TyFun l t1 t2 -> TyFun (f l) t1 t2 TyTuple l b ts -> TyTuple (f l) b ts TyList l t -> TyList (f l) t TyApp l t1 t2 -> TyApp (f l) t1 t2 TyVar l n -> TyVar (f l) n TyCon l qn -> TyCon (f l) qn TyParen l t -> TyParen (f l) t TyInfix l ta qn tb -> TyInfix (f l) ta qn tb TyKind l t k -> TyKind (f l) t k instance Annotated TyVarBind where ann (KindedVar l n k) = l ann (UnkindedVar l n) = l amap f (KindedVar l n k) = KindedVar (f l) n k amap f (UnkindedVar l n) = UnkindedVar (f l) n instance Annotated Kind where ann (KindStar l) = l ann (KindBang l) = l ann (KindFn l k1 k2) = l ann (KindParen l k) = l ann (KindVar l v) = l amap f (KindStar l) = KindStar (f l) amap f (KindBang l) = KindBang (f l) amap f (KindFn l k1 k2) = KindFn (f l) k1 k2 amap f (KindParen l k) = KindParen (f l) k amap f (KindVar l n) = KindVar (f l) n instance Annotated FunDep where ann (FunDep l ns1 ns2) = l amap f (FunDep l ns1 ns2) = FunDep (f l) ns1 ns2 instance Annotated Context where ann (CxSingle l asst ) = l ann (CxTuple l assts) = l ann (CxParen l ctxt ) = l ann (CxEmpty l) = l amap f (CxSingle l asst ) = CxSingle (f l) asst amap f (CxTuple l assts) = CxTuple (f l) assts amap f (CxParen l ctxt ) = CxParen (f l) ctxt amap f (CxEmpty l) = CxEmpty (f l) instance Annotated Asst where ann asst = case asst of ClassA l qn ts -> l InfixA l ta qn tb -> l IParam l ipn t -> l EqualP l t1 t2 -> l amap f asst = case asst of ClassA l qn ts -> ClassA (f l) qn ts InfixA l ta qn tb -> InfixA (f l) ta qn tb IParam l ipn t -> IParam (f l) ipn t EqualP l t1 t2 -> EqualP (f l) t1 t2 instance Annotated Literal where ann lit = case lit of Char l c rw -> l String l s rw -> l Int l i rw -> l Frac l r rw -> l PrimInt l i rw -> l PrimWord l i rw -> l PrimFloat l r rw -> l PrimDouble l r rw -> l PrimChar l c rw -> l PrimString l s rw -> l amap = fmap instance Annotated Exp where ann e = case e of Var l qn -> l IPVar l ipn -> l Con l qn -> l Lit l lit -> l InfixApp l e1 qop e2 -> l App l e1 e2 -> l NegApp l e -> l Lambda l ps e -> l Let l bs e -> l If l ec et ee -> l Case l e alts -> l Do l ss -> l MDo l ss -> l Tuple l bx es -> l TupleSection l bx mes -> l List l es -> l Paren l e -> l LeftSection l e qop -> l RightSection l qop e -> l RecConstr l qn fups -> l RecUpdate l e fups -> l EnumFrom l e -> l EnumFromTo l ef et -> l EnumFromThen l ef et -> l EnumFromThenTo l ef eth eto -> l ListComp l e qss -> l ParComp l e qsss -> l ExpTypeSig l e t -> l VarQuote l qn -> l TypQuote l qn -> l BracketExp l br -> l SpliceExp l sp -> l QuasiQuote l sn se -> l XTag l xn xas me es -> l XETag l xn xas me -> l XPcdata l s -> l XExpTag l e -> l XChildTag l es -> l CorePragma l s e -> l SCCPragma l s e -> l GenPragma l s n12 n34 e -> l Proc l p e -> l LeftArrApp l e1 e2 -> l RightArrApp l e1 e2 -> l LeftArrHighApp l e1 e2 -> l RightArrHighApp l e1 e2 -> l amap f e = case e of Var l qn -> Var (f l) qn IPVar l ipn -> IPVar (f l) ipn Con l qn -> Con (f l) qn Lit l lit -> Lit (f l) lit InfixApp l e1 qop e2 -> InfixApp (f l) e1 qop e2 App l e1 e2 -> App (f l) e1 e2 NegApp l e -> NegApp (f l) e Lambda l ps e -> Lambda (f l) ps e Let l bs e -> Let (f l) bs e If l ec et ee -> If (f l) ec et ee Case l e alts -> Case (f l) e alts Do l ss -> Do (f l) ss MDo l ss -> MDo (f l) ss Tuple l bx es -> Tuple (f l) bx es TupleSection l bx mes -> TupleSection (f l) bx mes List l es -> List (f l) es Paren l e -> Paren (f l) e LeftSection l e qop -> LeftSection (f l) e qop RightSection l qop e -> RightSection (f l) qop e RecConstr l qn fups -> RecConstr (f l) qn fups RecUpdate l e fups -> RecUpdate (f l) e fups EnumFrom l e -> EnumFrom (f l) e EnumFromTo l ef et -> EnumFromTo (f l) ef et EnumFromThen l ef et -> EnumFromThen (f l) ef et EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) ef eth eto ListComp l e qss -> ListComp (f l) e qss ParComp l e qsss -> ParComp (f l) e qsss ExpTypeSig l e t -> ExpTypeSig (f l) e t VarQuote l qn -> VarQuote (f l) qn TypQuote l qn -> TypQuote (f l) qn BracketExp l br -> BracketExp (f l) br SpliceExp l sp -> SpliceExp (f l) sp QuasiQuote l sn se -> QuasiQuote (f l) sn se XTag l xn xas me es -> XTag (f l) xn xas me es XETag l xn xas me -> XETag (f l) xn xas me XPcdata l s -> XPcdata (f l) s XExpTag l e -> XExpTag (f l) e XChildTag l es -> XChildTag (f l) es CorePragma l s e -> CorePragma (f l) s e SCCPragma l s e -> SCCPragma (f l) s e GenPragma l s n12 n34 e -> GenPragma (f l) s n12 n34 e Proc l p e -> Proc (f l) p e LeftArrApp l e1 e2 -> LeftArrApp (f l) e1 e2 RightArrApp l e1 e2 -> RightArrApp (f l) e1 e2 LeftArrHighApp l e1 e2 -> LeftArrHighApp (f l) e1 e2 RightArrHighApp l e1 e2 -> RightArrHighApp (f l) e1 e2 instance Annotated XName where ann (XName l s) = l ann (XDomName l sd sn) = l amap = fmap instance Annotated XAttr where ann (XAttr l xn e) = l amap f (XAttr l xn e) = XAttr (f l) xn e instance Annotated Bracket where ann (ExpBracket l e) = l ann (PatBracket l p) = l ann (TypeBracket l t) = l ann (DeclBracket l ds) = l amap f (ExpBracket l e) = ExpBracket (f l) e amap f (PatBracket l p) = PatBracket (f l) p amap f (TypeBracket l t) = TypeBracket (f l) t amap f (DeclBracket l ds) = DeclBracket (f l) ds instance Annotated Splice where ann (IdSplice l s) = l ann (ParenSplice l e) = l amap f (IdSplice l s) = IdSplice (f l) s amap f (ParenSplice l e) = ParenSplice (f l) e instance Annotated Safety where ann (PlayRisky l) = l ann (PlaySafe l b) = l ann (PlayInterruptible l) = l amap = fmap instance Annotated CallConv where ann (StdCall l) = l ann (CCall l) = l ann (CPlusPlus l) = l ann (DotNet l) = l ann (Jvm l) = l ann (Js l) = l ann (CApi l) = l amap = fmap instance Annotated ModulePragma where ann (LanguagePragma l ns) = l ann (OptionsPragma l mt s) = l ann (AnnModulePragma l a) = l amap f (LanguagePragma l ns) = LanguagePragma (f l) ns amap f (AnnModulePragma l a) = AnnModulePragma (f l) a amap f p = fmap f p instance Annotated Activation where ann (ActiveFrom l k) = l ann (ActiveUntil l k) = l amap = fmap instance Annotated Rule where ann (Rule l s act mrvs e1 e2) = l amap f (Rule l s act mrvs e1 e2) = Rule (f l) s act mrvs e1 e2 instance Annotated RuleVar where ann (RuleVar l n) = l ann (TypedRuleVar l n t) = l amap f (RuleVar l n) = RuleVar (f l) n amap f (TypedRuleVar l n t) = TypedRuleVar (f l) n t instance Annotated WarningText where ann (DeprText l s) = l ann (WarnText l s) = l amap = fmap instance Annotated Pat where ann p = case p of PVar l n -> l PLit l lit -> l PNeg l p -> l PNPlusK l n k -> l PInfixApp l pa qn pb -> l PApp l qn ps -> l PTuple l bx ps -> l PList l ps -> l PParen l p -> l PRec l qn pfs -> l PAsPat l n p -> l PWildCard l -> l PIrrPat l p -> l PatTypeSig l p t -> l PViewPat l e p -> l PRPat l rps -> l PXTag l xn pxas mp ps -> l PXETag l xn pxas mp -> l PXPcdata l s -> l PXPatTag l p -> l PXRPats l rps -> l PExplTypeArg l qn t -> l PQuasiQuote l sn st -> l PBangPat l p -> l amap f p = case p of PVar l n -> PVar (f l) n PLit l lit -> PLit (f l) lit PNeg l p -> PNeg (f l) p PNPlusK l n k -> PNPlusK (f l) n k PInfixApp l pa qn pb -> PInfixApp (f l) pa qn pb PApp l qn ps -> PApp (f l) qn ps PTuple l bx ps -> PTuple (f l) bx ps PList l ps -> PList (f l) ps PParen l p -> PParen (f l) p PRec l qn pfs -> PRec (f l) qn pfs PAsPat l n p -> PAsPat (f l) n p PWildCard l -> PWildCard (f l) PIrrPat l p -> PIrrPat (f l) p PatTypeSig l p t -> PatTypeSig (f l) p t PViewPat l e p -> PViewPat (f l) e p PRPat l rps -> PRPat (f l) rps PXTag l xn pxas mp ps -> PXTag (f l) xn pxas mp ps PXETag l xn pxas mp -> PXETag (f l) xn pxas mp PXPcdata l s -> PXPcdata (f l) s PXPatTag l p -> PXPatTag (f l) p PXRPats l rps -> PXRPats (f l) rps PExplTypeArg l qn t -> PExplTypeArg (f l) qn t PQuasiQuote l sn st -> PQuasiQuote (f l) sn st PBangPat l p -> PBangPat (f l) p instance Annotated PXAttr where ann (PXAttr l xn p) = l amap f (PXAttr l xn p) = PXAttr (f l) xn p instance Annotated RPatOp where ann (RPStar l) = l ann (RPStarG l) = l ann (RPPlus l) = l ann (RPPlusG l) = l ann (RPOpt l) = l ann (RPOptG l) = l amap = fmap instance Annotated RPat where ann rp = case rp of RPOp l rp rop -> l RPEither l rp1 rp2 -> l RPSeq l rps -> l RPGuard l p ss -> l RPCAs l n rp -> l RPAs l n rp -> l RPParen l rp -> l RPPat l p -> l amap f rp = case rp of RPOp l rp rop -> RPOp (f l) rp rop RPEither l rp1 rp2 -> RPEither (f l) rp1 rp2 RPSeq l rps -> RPSeq (f l) rps RPGuard l p ss -> RPGuard (f l) p ss RPCAs l n rp -> RPCAs (f l) n rp RPAs l n rp -> RPAs (f l) n rp RPParen l rp -> RPParen (f l) rp RPPat l p -> RPPat (f l) p instance Annotated PatField where ann (PFieldPat l qn p) = l ann (PFieldPun l n) = l ann (PFieldWildcard l) = l amap f (PFieldPat l qn p) = PFieldPat (f l) qn p amap f (PFieldPun l n) = PFieldPun (f l) n amap f (PFieldWildcard l) = PFieldWildcard (f l) instance Annotated Stmt where ann (Generator l p e) = l ann (Qualifier l e) = l ann (LetStmt l bs) = l ann (RecStmt l ss) = l amap f (Generator l p e) = Generator (f l) p e amap f (Qualifier l e) = Qualifier (f l) e amap f (LetStmt l bs) = LetStmt (f l) bs amap f (RecStmt l ss) = RecStmt (f l) ss instance Annotated QualStmt where ann (QualStmt l s) = l ann (ThenTrans l e) = l ann (ThenBy l e1 e2) = l ann (GroupBy l e) = l ann (GroupUsing l e) = l ann (GroupByUsing l e1 e2) = l amap f (QualStmt l s) = QualStmt (f l) s amap f (ThenTrans l e) = ThenTrans (f l) e amap f (ThenBy l e1 e2) = ThenBy (f l) e1 e2 amap f (GroupBy l e) = GroupBy (f l) e amap f (GroupUsing l e) = GroupUsing (f l) e amap f (GroupByUsing l e1 e2) = GroupByUsing (f l) e1 e2 instance Annotated FieldUpdate where ann (FieldUpdate l qn e) = l ann (FieldPun l n) = l ann (FieldWildcard l) = l amap f (FieldUpdate l qn e) = FieldUpdate (f l) qn e amap f (FieldPun l n) = FieldPun (f l) n amap f (FieldWildcard l) = FieldWildcard (f l) instance Annotated Alt where ann (Alt l p gs bs) = l amap f (Alt l p gs bs) = Alt (f l) p gs bs instance Annotated GuardedAlts where ann (UnGuardedAlt l e) = l ann (GuardedAlts l galts) = l amap f (UnGuardedAlt l e) = UnGuardedAlt (f l) e amap f (GuardedAlts l galts) = GuardedAlts (f l) galts instance Annotated GuardedAlt where ann (GuardedAlt l ss e) = l amap f (GuardedAlt l ss e) = GuardedAlt (f l) ss e haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Annotated/ExactPrint.hs0000644000000000000000000020045112204617765024342 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Annotated.ExactPrint -- Copyright : (c) Niklas Broberg 2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- Exact-printer for Haskell abstract syntax. The input is a (semi-concrete) -- abstract syntax tree, annotated with exact source information to enable -- printing the tree exactly as it was parsed. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Annotated.ExactPrint ( exactPrint , ExactP ) where import Language.Haskell.Exts.Annotated.Syntax import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.Comments import Control.Monad (when) import Control.Arrow ((***), (&&&)) import Data.List (intersperse) -- import Debug.Trace (trace) ------------------------------------------------------ -- The EP monad and basic combinators type Pos = (Int,Int) pos :: (SrcInfo loc) => loc -> Pos pos ss = (startLine ss, startColumn ss) newtype EP x = EP (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) instance Monad EP where return x = EP $ \l cs -> (x, l, cs, id) EP m >>= k = EP $ \l0 c0 -> let (a, l1, c1, s1) = m l0 c0 EP f = k a (b, l2, c2, s2) = f l1 c1 in (b, l2, c2, s1 . s2) runEP :: EP () -> [Comment] -> String runEP (EP f) cs = let (_,_,_,s) = f (1,1) cs in s "" getPos :: EP Pos getPos = EP (\l cs -> (l,l,cs,id)) setPos :: Pos -> EP () setPos l = EP (\_ cs -> ((),l,cs,id)) printString :: String -> EP () printString str = EP (\(l,c) cs -> ((), (l,c+length str), cs, showString str)) getComment :: EP (Maybe Comment) getComment = EP $ \l cs -> let x = case cs of c:_ -> Just c _ -> Nothing in (x, l, cs, id) dropComment :: EP () dropComment = EP $ \l cs -> let cs' = case cs of (_:cs) -> cs _ -> cs in ((), l, cs', id) newLine :: EP () newLine = do (l,_) <- getPos printString "\n" setPos (l+1,1) padUntil :: Pos -> EP () padUntil (l,c) = do (l1,c1) <- getPos case {- trace (show ((l,c), (l1,c1))) -} () of _ {-()-} | l1 >= l && c1 <= c -> printString $ replicate (c - c1) ' ' | l1 < l -> newLine >> padUntil (l,c) | otherwise -> return () mPrintComments :: Pos -> EP () mPrintComments p = do mc <- getComment case mc of Nothing -> return () Just (Comment multi s str) -> when (pos s < p) $ do dropComment padUntil (pos s) printComment multi str setPos (srcSpanEndLine s, srcSpanEndColumn s) mPrintComments p printComment :: Bool -> String -> EP () printComment b str | b = printString $ "{-" ++ str ++ "-}" | otherwise = printString $ "--" ++ str printWhitespace :: Pos -> EP () printWhitespace p = mPrintComments p >> padUntil p printStringAt :: Pos -> String -> EP () printStringAt p str = printWhitespace p >> printString str errorEP :: String -> EP a errorEP = fail ------------------------------------------------------------------------------ -- Printing of source elements -- | Print an AST exactly as specified by the annotations on the nodes in the tree. exactPrint :: (ExactP ast) => ast SrcSpanInfo -> [Comment] -> String exactPrint ast cs = runEP (exactPC ast) cs exactPC :: (ExactP ast) => ast SrcSpanInfo -> EP () exactPC ast = let p = pos (ann ast) in mPrintComments p >> padUntil p >> exactP ast printSeq :: [(Pos, EP ())] -> EP () printSeq [] = return () printSeq ((p,pr):xs) = printWhitespace p >> pr >> printSeq xs printStrs :: SrcInfo loc => [(loc, String)] -> EP () printStrs = printSeq . map (pos *** printString) printPoints :: SrcSpanInfo -> [String] -> EP () printPoints l = printStrs . zip (srcInfoPoints l) printInterleaved, printInterleaved' :: (Annotated ast, ExactP ast, SrcInfo loc) => [(loc, String)] -> [ast SrcSpanInfo] -> EP () printInterleaved sistrs asts = printSeq $ interleave (map (pos *** printString ) sistrs) (map (pos . ann &&& exactP) asts) printInterleaved' sistrs (a:asts) = exactPC a >> printInterleaved sistrs asts printStreams :: [(Pos, EP ())] -> [(Pos, EP ())] -> EP () printStreams [] ys = printSeq ys printStreams xs [] = printSeq xs printStreams (x@(p1,ep1):xs) (y@(p2,ep2):ys) | p1 <= p2 = printWhitespace p1 >> ep1 >> printStreams xs (y:ys) | otherwise = printWhitespace p2 >> ep2 >> printStreams (x:xs) ys interleave :: [a] -> [a] -> [a] interleave [] ys = ys interleave xs [] = xs interleave (x:xs) (y:ys) = x:y: interleave xs ys maybeEP :: (a -> EP ()) -> Maybe a -> EP () maybeEP = maybe (return ()) bracketList :: (Annotated ast, ExactP ast) => (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP () bracketList (a,b,c) poss asts = printInterleaved (pList poss (a,b,c)) asts pList (p:ps) (a,b,c) = (p,a) : pList' ps (b,c) pList' [] _ = [] pList' [p] (_,c) = [(p,c)] pList' (p:ps) (b,c) = (p, b) : pList' ps (b,c) parenList, squareList, curlyList, parenHashList :: (Annotated ast, ExactP ast) => [SrcSpan] -> [ast SrcSpanInfo] -> EP () parenList = bracketList ("(",",",")") squareList = bracketList ("[",",","]") curlyList = bracketList ("{",",","}") parenHashList = bracketList ("(#",",","#)") layoutList :: (Functor ast, Show (ast ()), Annotated ast, ExactP ast) => [SrcSpan] -> [ast SrcSpanInfo] -> EP () layoutList poss asts = printStreams (map (pos *** printString) $ lList poss) (map (pos . ann &&& exactP) asts) lList (p:ps) = (if isNullSpan p then (p,"") else (p,"{")) : lList' ps lList' [] = [] lList' [p] = [if isNullSpan p then (p,"") else (p,"}")] lList' (p:ps) = (if isNullSpan p then (p,"") else (p,";")) : lList' ps printSemi :: SrcSpan -> EP () printSemi p = do printWhitespace (pos p) when (not $ isNullSpan p) $ printString ";" -------------------------------------------------- -- Exact printing class Annotated ast => ExactP ast where exactP :: ast SrcSpanInfo -> EP () instance ExactP Literal where exactP lit = case lit of Char _ _ rw -> printString ('\'':rw ++ "\'") String _ _ rw -> printString ('\"':rw ++ "\"") Int _ _ rw -> printString (rw) Frac _ _ rw -> printString (rw) PrimInt _ _ rw -> printString (rw ++ "#" ) PrimWord _ _ rw -> printString (rw ++ "##") PrimFloat _ _ rw -> printString (rw ++ "#" ) PrimDouble _ _ rw -> printString (rw ++ "##") PrimChar _ _ rw -> printString ('\'':rw ++ "\'#" ) PrimString _ _ rw -> printString ('\"':rw ++ "\"#" ) instance ExactP ModuleName where exactP (ModuleName l str) = printString str instance ExactP SpecialCon where exactP sc = case sc of UnitCon l -> printPoints l ["(",")"] ListCon l -> printPoints l ["[","]"] FunCon l -> printPoints l ["(","->",")"] TupleCon l b n -> printPoints l $ case b of Unboxed -> "(#": replicate (n-1) "," ++ ["#)"] _ -> "(" : replicate (n-1) "," ++ [")"] Cons l -> printString ":" UnboxedSingleCon l -> printPoints l ["(#","#)"] isSymbol :: Name l -> Bool isSymbol (Symbol _ _) = True isSymbol _ = False getName :: QName l -> Name l getName (UnQual _ s) = s getName (Qual _ _ s) = s getName (Special l (Cons _)) = Symbol l ":" getName (Special l (FunCon _)) = Symbol l "->" getName (Special l s) = Ident l (specialName s) specialName :: SpecialCon l -> String specialName (UnitCon _) = "()" specialName (ListCon _) = "[]" specialName (FunCon _) = "->" specialName (TupleCon _ b n) = "(" ++ hash ++ replicate (n-1) ',' ++ hash ++ ")" where hash = case b of Unboxed -> "#" _ -> "" specialName (Cons _) = ":" instance ExactP QName where exactP qn | isSymbol (getName qn) = do case srcInfoPoints (ann qn) of [a,b,c] -> do printString "(" printWhitespace (pos b) epQName qn printStringAt (pos c) ")" _ -> errorEP "ExactP: QName is given wrong number of srcInfoPoints" | otherwise = epQName qn epQName :: QName SrcSpanInfo -> EP () epQName qn = case qn of Qual l mn n -> exactP mn >> printString "." >> epName n UnQual l n -> epName n Special l sc -> exactP sc epInfixQName :: QName SrcSpanInfo -> EP () epInfixQName qn | isSymbol (getName qn) = printWhitespace (pos (ann qn)) >> epQName qn | otherwise = do case srcInfoPoints (ann qn) of [a,b,c] -> do printStringAt (pos a) "`" printWhitespace (pos b) epQName qn printStringAt (pos c) "`" _ -> errorEP "ExactP: QName (epInfixName) is given wrong number of srcInfoPoints" instance ExactP Name where exactP n = case n of Ident l str -> printString str Symbol l str -> do case srcInfoPoints l of [a,b,c] -> do printString "(" printWhitespace (pos b) printString str printStringAt (pos c) ")" _ -> errorEP "ExactP: Name is given wrong number of srcInfoPoints" epName :: Name SrcSpanInfo -> EP () epName (Ident _ str) = printString str epName (Symbol _ str) = printString str epInfixName :: Name SrcSpanInfo -> EP () epInfixName n | isSymbol n = printWhitespace (pos (ann n)) >> epName n | otherwise = do case srcInfoPoints (ann n) of [a,b,c] -> do printStringAt (pos a) "`" printWhitespace (pos b) epName n printStringAt (pos c) "`" _ -> errorEP "ExactP: Name (epInfixName) is given wrong number of srcInfoPoints" instance ExactP IPName where exactP ipn = case ipn of IPDup l str -> printString $ '?':str IPLin l str -> printString $ '%':str instance ExactP QOp where exactP qop = case qop of QVarOp l qn -> epInfixQName qn QConOp l qn -> epInfixQName qn instance ExactP Op where exactP op = case op of VarOp l n -> epInfixName n ConOp l n -> epInfixName n instance ExactP CName where exactP cn = case cn of VarName l n -> exactP n ConName l n -> exactP n instance ExactP ExportSpec where exactP espec = case espec of EVar l qn -> exactP qn EAbs l qn -> exactP qn EThingAll l qn -> exactP qn >> printPoints l ["(","..",")"] EThingWith l qn cns -> let k = length (srcInfoPoints l) in exactP qn >> printInterleaved (zip (srcInfoPoints l) $ "(":replicate (k-2) "," ++ [")"]) cns EModuleContents l mn -> printString "module" >> exactPC mn instance ExactP ExportSpecList where exactP (ExportSpecList l ess) = let k = length (srcInfoPoints l) in printInterleaved (zip (srcInfoPoints l) $ "(": replicate (k-2) "," ++ [")"]) ess instance ExactP ImportSpecList where exactP (ImportSpecList l hid ispecs) = do let pts = srcInfoPoints l pts <- if hid then do let (x:pts') = pts printStringAt (pos x) "hiding" return pts' else return pts let k = length pts printInterleaved (zip pts $ "(": replicate (k-2) "," ++ [")"]) ispecs instance ExactP ImportSpec where exactP ispec = case ispec of IVar l n -> exactP n IAbs l n -> exactP n IThingAll l n -> exactP n >> printPoints l ["(","..",")"] IThingWith l n cns -> let k = length (srcInfoPoints l) in exactP n >> printInterleaved (zip (srcInfoPoints l) $ "(":replicate (k-2) "," ++ [")"]) cns instance ExactP ImportDecl where exactP (ImportDecl l mn qf src mpkg mas mispecs) = do printString "import" case srcInfoPoints l of (a:pts) -> do pts <- if src then case pts of x:y:pts' -> do printStringAt (pos x) "{-# SOURCE" printStringAt (pos y) "#-}" return pts' _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" else return pts pts <- if qf then case pts of x:pts' -> do printStringAt (pos x) "qualified" return pts' _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" else return pts pts <- case mpkg of Just pkg -> case pts of x:pts' -> do printStringAt (pos x) $ show pkg return pts' _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" _ -> return pts exactPC mn pts <- case mas of Just as -> case pts of x:pts' -> do printStringAt (pos x) "as" exactPC as return pts' _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" _ -> return pts case mispecs of Nothing -> return () Just ispecs -> exactPC ispecs _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" instance ExactP Module where exactP mdl = case mdl of Module l mmh oss ids decls -> do let (oPts, pts) = splitAt (max (length oss + 1) 2) (srcInfoPoints l) layoutList oPts oss maybeEP exactPC mmh printStreams (map (pos *** printString) $ lList pts) (map (pos . ann &&& exactPC) ids ++ map (pos . ann &&& exactPC) (sepFunBinds decls)) XmlPage l _mn oss xn attrs mat es -> do let (oPts, pPts) = splitAt (max (length oss + 1) 2) $ srcInfoPoints l case pPts of [a,b,c,d,e] -> do layoutList oPts oss printStringAt (pos a) "<" exactPC xn mapM_ exactPC attrs maybeEP exactPC mat printStringAt (pos b) ">" mapM_ exactPC es printStringAt (pos c) "" _ -> errorEP "ExactP: Module: XmlPage is given wrong number of srcInfoPoints" XmlHybrid l mmh oss ids decls xn attrs mat es -> do let (oPts, pts) = splitAt (max (length oss + 1) 2) (srcInfoPoints l) layoutList oPts oss maybeEP exactPC mmh let (dPts, pPts) = splitAt (length pts - 5) pts case pPts of [a,b,c,d,e] -> do printStreams (map (\(p,s) -> (pos p, printString s)) $ lList dPts) (map (\i -> (pos $ ann i, exactPC i)) ids ++ map (\d -> (pos $ ann d, exactPC d)) (sepFunBinds decls)) printStringAt (pos a) "<" exactPC xn mapM_ exactPC attrs maybeEP exactPC mat printStringAt (pos b) ">" mapM_ exactPC es printStringAt (pos c) "" _ -> errorEP "ExactP: Module: XmlHybrid is given wrong number of srcInfoPoints" instance ExactP ModuleHead where exactP (ModuleHead l mn mwt mess) = do case srcInfoPoints l of [a,b] -> do printStringAt (pos a) "module" exactPC mn maybeEP exactPC mwt maybeEP exactPC mess printStringAt (pos b) "where" _ -> errorEP "ExactP: ModuleHead is given wrong number of srcInfoPoints" instance ExactP ModulePragma where exactP op = case op of LanguagePragma l ns -> let pts = srcInfoPoints l k = length ns - 1 -- number of commas m = length pts - k - 2 -- number of virtual semis, likely 0 in printInterleaved (zip pts ("{-# LANGUAGE":replicate k "," ++ replicate m "" ++ ["#-}"])) ns OptionsPragma l mt str -> let k = length (srcInfoPoints l) opstr = "{-# OPTIONS" ++ case mt of { Just t -> "_" ++ show t ; _ -> "" } ++ " " ++ str in printPoints l $ opstr : replicate (k-2) "" ++ ["#-}"] AnnModulePragma l ann -> case srcInfoPoints l of [a,b] -> do printString $ "{-# ANN" exactPC ann printStringAt (pos b) "#-}" _ -> errorEP "ExactP: ModulePragma: AnnPragma is given wrong number of srcInfoPoints" instance ExactP WarningText where exactP (DeprText l str) = printPoints l ["{-# DEPRECATED", str, "#-}"] exactP (WarnText l str) = printPoints l ["{-# WARNING", str, "#-}"] instance ExactP Assoc where exactP a = case a of AssocNone l -> printString "infix" AssocLeft l -> printString "infixl" AssocRight l -> printString "infixr" instance ExactP DataOrNew where exactP (DataType l) = printString "data" exactP (NewType l) = printString "newtype" instance ExactP Decl where exactP decl = case decl of TypeDecl l dh t -> case srcInfoPoints l of [a,b] -> do printStringAt (pos a) "type" exactPC dh printStringAt (pos b) "=" exactPC t _ -> errorEP "ExactP: Decl: TypeDecl is given wrong number of srcInfoPoints" TypeFamDecl l dh mk -> case srcInfoPoints l of a:b:ps -> do printStringAt (pos a) "type" printStringAt (pos b) "family" exactPC dh maybeEP (\k -> printStringAt (pos (head ps)) "::" >> exactPC k) mk _ -> errorEP "ExactP: Decl: TypeFamDecl is given wrong number of srcInfoPoints" DataDecl l dn mctxt dh constrs mder -> do exactP dn maybeEP exactPC mctxt exactPC dh -- the next line works for empty data types since the srcInfoPoints will be empty then printInterleaved (zip (srcInfoPoints l) ("=": repeat "|")) constrs maybeEP exactPC mder GDataDecl l dn mctxt dh mk gds mder -> do let pts = srcInfoPoints l exactP dn maybeEP exactPC mctxt exactPC dh pts <- case mk of Nothing -> return pts Just kd -> case pts of p:pts' -> do printStringAt (pos p) "::" exactPC kd return pts' _ -> errorEP "ExactP: Decl: GDataDecl is given too few srcInfoPoints" case pts of x:pts -> do printStringAt (pos x) "where" layoutList pts gds maybeEP exactPC mder _ -> errorEP "ExactP: Decl: GDataDecl is given too few srcInfoPoints" DataFamDecl l mctxt dh mk -> do printString "data" maybeEP exactPC mctxt exactPC dh maybeEP (\kd -> printStringAt (pos (head (srcInfoPoints l))) "::" >> exactPC kd) mk TypeInsDecl l t1 t2 -> case srcInfoPoints l of [a,b,c] -> do printString "type" printStringAt (pos b) "instance" exactPC t1 printStringAt (pos c) "=" exactPC t2 _ -> errorEP "ExactP: Decl: TypeInsDecl is given wrong number of srcInfoPoints" DataInsDecl l dn t constrs mder -> case srcInfoPoints l of p:pts -> do exactP dn printStringAt (pos p) "instance" exactPC t printInterleaved (zip pts ("=": repeat "|")) constrs maybeEP exactPC mder _ -> errorEP "ExactP: Decl: DataInsDecl is given too few srcInfoPoints" GDataInsDecl l dn t mk gds mder -> case srcInfoPoints l of p:pts -> do exactP dn printStringAt (pos p) "instance" exactPC t pts <- case mk of Nothing -> return pts Just kd -> case pts of p:pts' -> do printStringAt (pos p) "::" exactPC kd return pts' _ -> errorEP "ExactP: Decl: GDataInsDecl is given too few srcInfoPoints" case pts of x:pts -> do printStringAt (pos x) "where" layoutList pts gds maybeEP exactPC mder _ -> errorEP "ExactP: Decl: GDataInsDecl is given too few srcInfoPoints" _ -> errorEP "ExactP: Decl: GDataInsDecl is given too few srcInfoPoints" ClassDecl l mctxt dh fds mcds -> case srcInfoPoints l of a:pts -> do printString "class" maybeEP exactPC mctxt exactPC dh pts <- case fds of [] -> return pts _ -> do let (pts1, pts2) = splitAt (length fds) pts printInterleaved (zip pts1 ("|":repeat ",")) fds return pts2 maybeEP (\cds -> case pts of p:pts' -> do printStringAt (pos p) "where" layoutList pts' $ sepClassFunBinds cds _ -> errorEP "ExactP: Decl: ClassDecl is given too few srcInfoPoints" ) mcds _ -> errorEP "ExactP: Decl: ClassDecl is given too few srcInfoPoints" InstDecl l mctxt ih mids -> case srcInfoPoints l of a:pts -> do printString "instance" maybeEP exactPC mctxt exactPC ih maybeEP (\ids -> do let (p:pts') = pts printStringAt (pos p) "where" layoutList pts' $ sepInstFunBinds ids ) mids _ -> errorEP "ExactP: Decl: InstDecl is given too few srcInfoPoints" DerivDecl l mctxt ih -> case srcInfoPoints l of [a,b] -> do printString "deriving" printStringAt (pos b) "instance" maybeEP exactPC mctxt exactPC ih _ -> errorEP "ExactP: Decl: DerivDecl is given wrong number of srcInfoPoints" InfixDecl l assoc mprec ops -> do let pts = srcInfoPoints l exactP assoc pts <- case mprec of Nothing -> return pts Just prec -> case pts of p:pts' -> do printStringAt (pos p) (show prec) return pts' _ -> errorEP "ExactP: Decl: InfixDecl is given too few srcInfoPoints" printInterleaved' (zip pts (repeat ",")) ops DefaultDecl l ts -> case srcInfoPoints l of a:pts -> do printString "default" printInterleaved (zip (init pts) ("(":repeat ",")) ts printStringAt (pos (last pts)) ")" _ -> errorEP "ExactP: Decl: DefaultDecl is given too few srcInfoPoints" SpliceDecl l spl -> exactP spl TypeSig l ns t -> do let pts = srcInfoPoints l printInterleaved' (zip pts (replicate (length pts - 1) "," ++ ["::"])) ns exactPC t FunBind l ms -> mapM_ exactPC ms PatBind l p mt rhs mbs -> do let pts = srcInfoPoints l exactP p pts <- case mt of Nothing -> return pts Just t -> case pts of x:pts'-> do printStringAt (pos x) "::" exactPC t return pts' _ -> errorEP "ExactP: Decl: PatBind is given too few srcInfoPoints" exactPC rhs maybeEP (\bs -> printStringAt (pos (head pts)) "where" >> exactPC bs) mbs ForImp l cc msf mstr n t -> case srcInfoPoints l of a:b:pts -> do printString "foreign" printStringAt (pos b) "import" exactPC cc maybeEP exactPC msf pts <- case mstr of Nothing -> return pts Just str -> case pts of x:pts' -> do printStringAt (pos x) (show str) return pts' _ -> errorEP "ExactP: Decl: ForImp is given too few srcInfoPoints" case pts of y:_ -> do exactPC n printStringAt (pos y) "::" exactPC t _ -> errorEP "ExactP: Decl: ForImp is given too few srcInfoPoints" _ -> errorEP "ExactP: Decl: ForImp is given too few srcInfoPoints" ForExp l cc mstr n t -> case srcInfoPoints l of a:b:pts -> do printString "foreign" printStringAt (pos b) "export" exactPC cc pts <- case mstr of Nothing -> return pts Just str -> case pts of x:pts' -> do printStringAt (pos x) (show str) return pts' _ -> errorEP "ExactP: Decl: ForExp is given too few srcInfoPoints" case pts of y:_ -> do exactPC n printStringAt (pos y) "::" exactPC t _ -> errorEP "ExactP: Decl: ForExp is given too few srcInfoPoints" _ -> errorEP "ExactP: Decl: ForExp is given too few srcInfoPoints" RulePragmaDecl l rs -> case srcInfoPoints l of [a,b] -> do printString "{-# RULES" mapM_ exactPC rs printStringAt (pos b) "#-}" _ -> errorEP "ExactP: Decl: RulePragmaDecl is given too few srcInfoPoints" DeprPragmaDecl l nstrs -> case srcInfoPoints l of a:pts -> do printString "{-# DEPRECATED" printWarndeprs (map pos (init pts)) nstrs printStringAt (pos (last pts)) "#-}" _ -> errorEP "ExactP: Decl: DeprPragmaDecl is given too few srcInfoPoints" WarnPragmaDecl l nstrs -> case srcInfoPoints l of a:pts -> do printString "{-# WARNING" printWarndeprs (map pos (init pts)) nstrs printStringAt (pos (last pts)) "#-}" _ -> errorEP "ExactP: Decl: WarnPragmaDecl is given too few srcInfoPoints" InlineSig l inl mact qn -> case srcInfoPoints l of [a,b] -> do printString $ if inl then "{-# INLINE" else "{-# NOINLINE" maybeEP exactPC mact exactPC qn printStringAt (pos b) "#-}" _ -> errorEP "ExactP: Decl: InlineSig is given wrong number of srcInfoPoints" InlineConlikeSig l mact qn -> case srcInfoPoints l of [a,b] -> do printString "{-# INLINE_CONLIKE" maybeEP exactPC mact exactPC qn printStringAt (pos b) "#-}" _ -> errorEP "ExactP: Decl: InlineConlikeSig is given wrong number of srcInfoPoints" SpecSig l mact qn ts -> case srcInfoPoints l of a:pts -> do printString "{-# SPECIALISE" maybeEP exactPC mact exactPC qn printInterleaved (zip pts ("::" : replicate (length pts - 2) "," ++ ["#-}"])) ts _ -> errorEP "ExactP: Decl: SpecSig is given too few srcInfoPoints" SpecInlineSig l b mact qn ts -> case srcInfoPoints l of a:pts -> do printString $ "{-# SPECIALISE " ++ if b then "INLINE" else "NOINLINE" maybeEP exactPC mact exactPC qn printInterleaved (zip pts ("::" : replicate (length pts - 2) "," ++ ["#-}"])) ts _ -> errorEP "ExactP: Decl: SpecInlineSig is given too few srcInfoPoints" InstSig l mctxt ih -> case srcInfoPoints l of [a,b,c] -> do printString $ "{-# SPECIALISE" printStringAt (pos b) "instance" maybeEP exactPC mctxt exactPC ih printStringAt (pos c) "#-}" _ -> errorEP "ExactP: Decl: InstSig is given wrong number of srcInfoPoints" AnnPragma l ann -> case srcInfoPoints l of [a,b] -> do printString $ "{-# ANN" exactPC ann printStringAt (pos b) "#-}" _ -> errorEP "ExactP: Decl: AnnPragma is given wrong number of srcInfoPoints" instance ExactP Annotation where exactP ann = case ann of Ann l n e -> do exactP n exactPC e TypeAnn l n e -> do printString "type" exactPC n exactPC e ModuleAnn l e -> do printString "module" exactPC e printWarndeprs :: [Pos] -> [([Name SrcSpanInfo], String)] -> EP () printWarndeprs _ [] = return () printWarndeprs ps ((ns,str):nsts) = printWd ps ns str nsts where printWd :: [Pos] -> [Name SrcSpanInfo] -> String -> [([Name SrcSpanInfo], String)] -> EP () printWd (p:ps) [] str nsts = printStringAt p (show str) >> printWarndeprs ps nsts printWd ps [n] str nsts = exactPC n >> printWd ps [] str nsts printWd (p:ps) (n:ns) str nsts = exactPC n >> printStringAt p "," >> printWd ps ns str nsts sepFunBinds :: [Decl SrcSpanInfo] -> [Decl SrcSpanInfo] sepFunBinds [] = [] sepFunBinds (FunBind _ ms:ds) = map (\m -> FunBind (ann m) [m]) ms ++ sepFunBinds ds sepFunBinds (d:ds) = d : sepFunBinds ds sepClassFunBinds :: [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo] sepClassFunBinds [] = [] sepClassFunBinds (ClsDecl _ (FunBind _ ms):ds) = map (\m -> ClsDecl (ann m) $ FunBind (ann m) [m]) ms ++ sepClassFunBinds ds sepClassFunBinds (d:ds) = d : sepClassFunBinds ds sepInstFunBinds :: [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo] sepInstFunBinds [] = [] sepInstFunBinds (InsDecl _ (FunBind _ ms):ds) = map (\m -> InsDecl (ann m) $ FunBind (ann m) [m]) ms ++ sepInstFunBinds ds sepInstFunBinds (d:ds) = d : sepInstFunBinds ds instance ExactP DeclHead where exactP dh = case dh of DHead l n tvs -> exactP n >> mapM_ exactPC tvs DHInfix l tva n tvb -> exactP tva >> epInfixName n >> exactPC tvb DHParen l dh -> case srcInfoPoints l of [_,b] -> printString "(" >> exactPC dh >> printStringAt (pos b) ")" _ -> errorEP "ExactP: DeclHead: DeclParen is given wrong number of srcInfoPoints" instance ExactP InstHead where exactP ih = case ih of IHead l qn ts -> exactP qn >> mapM_ exactPC ts IHInfix l ta qn tb -> exactP ta >> epInfixQName qn >> exactPC tb IHParen l ih -> case srcInfoPoints l of [_,b] -> printString "(" >> exactPC ih >> printStringAt (pos b) ")" _ -> errorEP "ExactP: InstHead: IHParen is given wrong number of srcInfoPoints" instance ExactP TyVarBind where exactP (KindedVar l n k) = case srcInfoPoints l of [a,b,c] -> do printString "(" exactPC n printStringAt (pos b) "::" exactPC k printStringAt (pos c) ")" _ -> errorEP "ExactP: TyVarBind: KindedVar is given wrong number of srcInfoPoints" exactP (UnkindedVar l n) = exactP n instance ExactP Kind where exactP kd = case kd of KindStar l -> printString "*" KindBang l -> printString "!" KindFn l k1 k2 -> case srcInfoPoints l of [a] -> do exactP k1 printStringAt (pos a) "->" exactPC k2 _ -> errorEP "ExactP: Kind: KindFn is given wrong number of srcInfoPoints" KindParen l kd -> do case srcInfoPoints l of [a,b] -> do printString "(" exactPC kd printStringAt (pos b) ")" _ -> errorEP "ExactP: Kind: KindParen is given wrong number of srcInfoPoints" KindVar l n -> exactP n instance ExactP Type where exactP t = case t of TyForall l mtvs mctxt t -> do let pts = srcInfoPoints l pts <- case mtvs of Nothing -> return pts Just tvs -> case pts of a:b:pts' -> do printString "forall" mapM_ exactPC tvs printStringAt (pos b) "." return pts' _ -> errorEP "ExactP: Type: TyForall is given too few srcInfoPoints" maybeEP exactPC mctxt exactPC t TyFun l t1 t2 -> do case srcInfoPoints l of [a] -> do exactP t1 printStringAt (pos a) "->" exactPC t2 _ -> errorEP "ExactP: Type: TyFun is given wrong number of srcInfoPoints" TyTuple l bx ts -> do case bx of Boxed -> parenList (srcInfoPoints l) ts Unboxed -> parenHashList (srcInfoPoints l) ts TyList l t -> do case srcInfoPoints l of [a,b] -> do printString "[" exactPC t printStringAt (pos b) "]" _ -> errorEP "ExactP: Type: TyList is given wrong number of srcInfoPoints" TyApp l t1 t2 -> exactP t1 >> exactPC t2 TyVar l n -> exactP n TyCon l qn -> exactP qn TyParen l t -> do case srcInfoPoints l of [a,b] -> do printString "(" exactPC t printStringAt (pos b) ")" _ -> errorEP "ExactP: Type: TyParen is given wrong number of srcInfoPoints" TyInfix l t1 qn t2 -> exactP t1 >> epInfixQName qn >> exactPC t2 TyKind l t kd -> do case srcInfoPoints l of [a,b,c] -> do printString "(" exactPC t printStringAt (pos b) "::" exactPC kd printStringAt (pos c) ")" _ -> errorEP "ExactP: Type: TyKind is given wrong number of srcInfoPoints" instance ExactP Context where exactP ctxt = do printContext ctxt printStringAt (pos . last . srcInfoPoints . ann $ ctxt) "=>" printContext ctxt = do let l = ann ctxt pts = init $ srcInfoPoints l case ctxt of CxParen l ctxt -> case pts of [a,b] -> do printStringAt (pos a) "(" printContext ctxt printStringAt (pos b) ")" _ -> errorEP "ExactP: Context: CxParen is given wrong number of srcInfoPoints" CxSingle l asst -> exactP asst CxEmpty l -> case pts of [a,b] -> do printStringAt (pos a) "(" printStringAt (pos b) ")" _ -> errorEP "ExactP: Context: CxEmpty is given wrong number of srcInfoPoints" CxTuple l assts -> parenList pts assts instance ExactP Asst where exactP asst = case asst of ClassA l qn ts -> exactP qn >> mapM_ exactPC ts InfixA l ta qn tb -> exactP ta >> epInfixQName qn >> exactPC tb IParam l ipn t -> case srcInfoPoints l of [a] -> do exactP ipn printStringAt (pos a) "::" exactPC t _ -> errorEP "ExactP: Asst: IParam is given wrong number of srcInfoPoints" EqualP l t1 t2 -> case srcInfoPoints l of [a] -> do exactP t1 printStringAt (pos a) "~" exactPC t2 instance ExactP Deriving where exactP (Deriving l ihs) = case srcInfoPoints l of x:pts -> do printString "deriving" case pts of [] -> exactPC $ head ihs _ -> parenList pts ihs _ -> errorEP "ExactP: Deriving is given too few srcInfoPoints" instance ExactP ClassDecl where exactP cdecl = case cdecl of ClsDecl l d -> exactP d ClsDataFam l mctxt dh mk -> case srcInfoPoints l of x:pts -> do printString "data" maybeEP exactPC mctxt exactPC dh maybeEP (\kd -> printStringAt (pos (head pts)) "::" >> exactPC kd) mk _ -> errorEP "ExactP: ClassDecl: ClsDataFam is given too few srcInfoPoints" ClsTyFam l dh mk -> case srcInfoPoints l of x:pts -> do printString "type" exactPC dh maybeEP (\kd -> printStringAt (pos (head pts)) "::" >> exactPC kd) mk _ -> errorEP "ExactP: ClassDecl: ClsTyFam is given too few srcInfoPoints" ClsTyDef l t1 t2 -> case srcInfoPoints l of a:b:pts -> do printString "type" exactPC t1 printStringAt (pos b) "=" exactPC t2 _ -> errorEP "ExactP: ClassDecl: ClsTyDef is given too few srcInfoPoints" instance ExactP InstDecl where exactP idecl = case idecl of InsDecl l d -> exactP d InsType l t1 t2 -> case srcInfoPoints l of [a,b] -> do printString "type" exactPC t1 printStringAt (pos b) "=" exactPC t2 InsData l dn t constrs mder -> do exactP dn exactPC t printInterleaved (zip (srcInfoPoints l) ("=": repeat "|")) constrs maybeEP exactPC mder InsGData l dn t mk gds mder -> do let pts = srcInfoPoints l exactP dn exactPC t pts <- case mk of Nothing -> return pts Just kd -> case pts of p:pts' -> do printStringAt (pos p) "::" exactPC kd return pts' _ -> errorEP "ExactP: InstDecl: InsGData is given too few srcInfoPoints" case pts of x:_ -> do printStringAt (pos x) "where" mapM_ exactPC gds maybeEP exactPC mder _ -> errorEP "ExactP: InstDecl: InsGData is given too few srcInfoPoints" -- InsInline l inl mact qn -> do -- case srcInfoPoints l of -- [a,b] -> do -- printString $ if inl then "{-# INLINE" else "{-# NOINLINE" -- maybeEP exactPC mact -- exactPC qn -- printStringAt (pos b) "#-}" -- _ -> errorEP "ExactP: InstDecl: InsInline is given wrong number of srcInfoPoints" instance ExactP FunDep where exactP (FunDep l nxs nys) = case srcInfoPoints l of [a] -> do mapM_ exactPC nxs printStringAt (pos a) "->" mapM_ exactPC nys _ -> errorEP "ExactP: FunDep is given wrong number of srcInfoPoints" instance ExactP QualConDecl where exactP (QualConDecl l mtvs mctxt cd) = do let pts = srcInfoPoints l pts <- case mtvs of Nothing -> return pts Just tvs -> case pts of a:b:pts' -> do printString "forall" mapM_ exactPC tvs printStringAt (pos b) "." return pts' _ -> errorEP "ExactP: QualConDecl is given wrong number of srcInfoPoints" maybeEP exactPC mctxt exactPC cd instance ExactP ConDecl where exactP cd = case cd of ConDecl l n bts -> exactP n >> mapM_ exactPC bts InfixConDecl l bta n btb -> exactP bta >> epInfixName n >> exactP btb RecDecl l n fds -> exactP n >> curlyList (srcInfoPoints l) fds instance ExactP GadtDecl where exactP (GadtDecl l n t) = case srcInfoPoints l of [a] -> do exactP n printStringAt (pos a) "::" exactPC t _ -> errorEP "ExactP: GadtDecl is given wrong number of srcInfoPoints" instance ExactP BangType where exactP bt = case bt of UnBangedTy l t -> exactP t BangedTy l t -> printString "!" >> exactPC t UnpackedTy l t -> case srcInfoPoints l of [a,b,c] -> do printString "{-# UNPACK" printStringAt (pos b) "#-}" printStringAt (pos c) "!" exactPC t _ -> errorEP "ExactP: BangType: UnpackedTy is given wrong number of srcInfoPoints" instance ExactP Splice where exactP (IdSplice l str) = printString $ '$':str exactP (ParenSplice l e) = case srcInfoPoints l of [a,b] -> do printString "$(" exactPC e printStringAt (pos b) ")" _ -> errorEP "ExactP: Splice: ParenSplice is given wrong number of srcInfoPoints" instance ExactP Exp where exactP exp = case exp of Var l qn -> exactP qn IPVar l ipn -> exactP ipn Con l qn -> exactP qn Lit l lit -> exactP lit InfixApp l e1 op e2 -> exactP e1 >> exactPC op >> exactPC e2 App l e1 e2 -> exactP e1 >> exactPC e2 NegApp l e -> printString "-" >> exactPC e Lambda l ps e -> case srcInfoPoints l of [a,b] -> do printString "\\" mapM_ exactPC ps printStringAt (pos b) "->" exactPC e _ -> errorEP "ExactP: Exp: Lambda is given wrong number of srcInfoPoints" Let l bs e -> case srcInfoPoints l of [a,b] -> do printString "let" exactPC bs printStringAt (pos b) "in" exactPC e _ -> errorEP "ExactP: Exp: Let is given wrong number of srcInfoPoints" If l ec et ee -> -- traceShow (srcInfoPoints l) $ do -- First we need to sort out if there are any optional -- semicolons hiding among the srcInfoPoints. case srcInfoPoints l of (pIf:b:c:rest) -> do let (mpSemi1,pThen,rest2) = if snd (spanSize b) == 4 -- this is "then", not a semi then (Nothing, b, c:rest) else (Just b, c, rest) case rest2 of (c:rest3) -> do let (mpSemi2,rest4) = if snd (spanSize c) == 4 -- this is "else", not a semi then (Nothing, rest2) else (Just c, rest3) case rest4 of [pElse] -> do -- real work starts here: printString "if" exactPC ec maybeEP printSemi mpSemi1 printStringAt (pos pThen) "then" exactPC et maybeEP printSemi mpSemi2 printStringAt (pos pElse) "else" exactPC ee [] -> errorEP "ExactP: Exp: If is given too few srcInfoPoints" _ -> errorEP "ExactP: Exp: If is given too many srcInfoPoints" _ -> errorEP "ExactP: Exp: If is given too few srcInfoPoints" _ -> errorEP "ExactP: Exp: If is given too few srcInfoPoints" Case l e alts -> case srcInfoPoints l of a:b:pts -> do printString "case" exactPC e printStringAt (pos b) "of" layoutList pts alts _ -> errorEP "ExactP: Exp: Case is given too few srcInfoPoints" Do l stmts -> case srcInfoPoints l of a:pts -> do printString "do" layoutList pts stmts _ -> errorEP "ExactP: Exp: Do is given too few srcInfoPoints" MDo l stmts -> case srcInfoPoints l of a:pts -> do printString "mdo" layoutList pts stmts _ -> errorEP "ExactP: Exp: Mdo is given wrong number of srcInfoPoints" Tuple l bx es -> case bx of Boxed -> parenList (srcInfoPoints l) es Unboxed -> parenHashList (srcInfoPoints l) es TupleSection l bx mexps -> do let pts = srcInfoPoints l (o, e) = case bx of Boxed -> ("(", ")"); Unboxed -> ("(#", "#)") printSeq $ interleave (zip (map pos $ init pts) (map printString (o: repeat ",")) ++ [(pos $ last pts, printString e)]) (map (maybe (0,0) (pos . ann) &&& maybeEP exactPC) mexps) List l es -> squareList (srcInfoPoints l) es Paren l p -> parenList (srcInfoPoints l) [p] LeftSection l e qop -> case srcInfoPoints l of [a,b] -> do printString "(" exactPC e exactPC qop printStringAt (pos b) ")" _ -> errorEP "ExactP: Exp: LeftSection is given wrong number of srcInfoPoints" RightSection l qop e -> case srcInfoPoints l of [a,b] -> do printString "(" exactPC qop exactPC e printStringAt (pos b) ")" _ -> errorEP "ExactP: Exp: RightSection is given wrong number of srcInfoPoints" RecConstr l qn fups -> do let pts = srcInfoPoints l exactP qn curlyList pts fups RecUpdate l e fups -> do let pts = srcInfoPoints l exactP e curlyList pts fups EnumFrom l e -> case srcInfoPoints l of [a,b,c] -> do printString "[" exactPC e printStringAt (pos b) ".." printStringAt (pos c) "]" _ -> errorEP "ExactP: Exp: EnumFrom is given wrong number of srcInfoPoints" EnumFromTo l e1 e2 -> case srcInfoPoints l of [a,b,c] -> do printString "[" exactPC e1 printStringAt (pos b) ".." exactPC e2 printStringAt (pos c) "]" _ -> errorEP "ExactP: Exp: EnumFromTo is given wrong number of srcInfoPoints" EnumFromThen l e1 e2 -> case srcInfoPoints l of [a,b,c,d] -> do printString "[" exactPC e1 printStringAt (pos b) "," exactPC e2 printStringAt (pos c) ".." printStringAt (pos d) "]" _ -> errorEP "ExactP: Exp: EnumFromThen is given wrong number of srcInfoPoints" EnumFromThenTo l e1 e2 e3 -> case srcInfoPoints l of [a,b,c,d] -> do printString "[" exactPC e1 printStringAt (pos b) "," exactPC e2 printStringAt (pos c) ".." exactPC e3 printStringAt (pos d) "]" _ -> errorEP "ExactP: Exp: EnumFromToThen is given wrong number of srcInfoPoints" ListComp l e qss -> case srcInfoPoints l of a:pts -> do printString "[" exactPC e bracketList ("|",",","]") pts qss _ -> errorEP "ExactP: Exp: ListComp is given too few srcInfoPoints" ParComp l e qsss -> case srcInfoPoints l of a:pts -> do let (strs, qss) = unzip $ pairUp qsss printString "[" exactPC e printInterleaved (zip pts (strs ++ ["]"])) qss _ -> errorEP "ExactP: Exp: ParComp is given wrong number of srcInfoPoints" where pairUp [] = [] pairUp ((a:as):xs) = ("|", a) : zip (repeat ",") as ++ pairUp xs ExpTypeSig l e t -> case srcInfoPoints l of [a] -> do exactP e printStringAt (pos a) "::" exactPC t _ -> errorEP "ExactP: Exp: ExpTypeSig is given wrong number of srcInfoPoints" VarQuote l qn -> do printString "'" exactPC qn TypQuote l qn -> do printString "''" exactPC qn BracketExp l br -> exactP br SpliceExp l sp -> exactP sp QuasiQuote l name qt -> do let qtLines = lines qt printString $ "[" ++ name ++ "|" sequence_ (intersperse newLine $ map printString qtLines) printString "|]" XTag l xn attrs mat es -> do case srcInfoPoints l of [a,b,c,d,e] -> do printString "<" exactPC xn mapM_ exactPC attrs maybeEP exactPC mat printStringAt (pos b) ">" mapM_ exactPC es printStringAt (pos c) "" -- TODO: Fugly hack/duplication, should be refactored -- For the case when there's an optional semicolon [a,b,semi,c,d,e] -> do printString "<" exactPC xn mapM_ exactPC attrs maybeEP exactPC mat printStringAt (pos b) ">" mapM_ exactPC es printSemi semi printStringAt (pos c) "" _ -> errorEP "ExactP: Exp: XTag is given wrong number of srcInfoPoints" XETag l xn attrs mat -> case srcInfoPoints l of [a,b] -> do printString "<" exactPC xn mapM_ exactPC attrs maybeEP exactPC mat printStringAt (pos b) "/>" _ -> errorEP "ExactP: Exp: XETag is given wrong number of srcInfoPoints" XPcdata l str -> do let strLines = lines str sequence_ (intersperse newLine $ map printString strLines) XExpTag l e -> case srcInfoPoints l of [a,b] -> do printString "<%" exactPC e printStringAt (pos b) "%>" _ -> errorEP "ExactP: Exp: XExpTag is given wrong number of srcInfoPoints" XChildTag l es -> case srcInfoPoints l of [a,b,c] -> do printString "<%>" mapM_ exactPC es printStringAt (pos b) "" -- Ugly duplication for when there's an optional semi [a,semi,b,c] -> do printString "<%>" mapM_ exactPC es printSemi semi printStringAt (pos b) "" _ -> errorEP "ExactP: Exp: XChildTag is given wrong number of srcInfoPoints" CorePragma l str e -> case srcInfoPoints l of [a,b] -> do printString $ "{-# CORE " ++ show str printStringAt (pos b) "#-}" exactPC e _ -> errorEP "ExactP: Exp: CorePragma is given wrong number of srcInfoPoints" SCCPragma l str e -> case srcInfoPoints l of [a,b] -> do printString $ "{-# SCC " ++ show str printStringAt (pos b) "#-}" exactPC e _ -> errorEP "ExactP: Exp: SCCPragma is given wrong number of srcInfoPoints" GenPragma l str (i1,i2) (i3,i4) e -> do printStrs $ zip (srcInfoPoints l) ["{-# GENERATED", show str, show i1, ":", show i2, "-", show i3, ":", show i4, "#-}"] exactPC e Proc l p e -> case srcInfoPoints l of [a,b] -> do printString "proc" exactPC p printStringAt (pos b) "->" exactPC e _ -> errorEP "ExactP: Exp: Proc is given wrong number of srcInfoPoints" LeftArrApp l e1 e2 -> case srcInfoPoints l of [a] -> do exactP e1 printStringAt (pos a) "-<" exactPC e2 _ -> errorEP "ExactP: Exp: LeftArrApp is given wrong number of srcInfoPoints" RightArrApp l e1 e2 -> do case srcInfoPoints l of [a] -> do exactP e1 printStringAt (pos a) ">-" exactPC e2 _ -> errorEP "ExactP: Exp: RightArrApp is given wrong number of srcInfoPoints" LeftArrHighApp l e1 e2 -> do case srcInfoPoints l of [a] -> do exactP e1 printStringAt (pos a) "-<<" exactPC e2 _ -> errorEP "ExactP: Exp: LeftArrHighApp is given wrong number of srcInfoPoints" RightArrHighApp l e1 e2 -> do case srcInfoPoints l of [a] -> do exactP e1 printStringAt (pos a) ">>-" exactPC e2 _ -> errorEP "ExactP: Exp: RightArrHighApp is given wrong number of srcInfoPoints" instance ExactP FieldUpdate where exactP fup = case fup of FieldUpdate l qn e -> do case srcInfoPoints l of [a] -> do exactP qn printStringAt (pos a) "=" exactPC e _ -> errorEP "ExactP: FieldUpdate is given wrong number of srcInfoPoints" FieldPun l n -> exactP n FieldWildcard l -> printString ".." instance ExactP Stmt where exactP stmt = case stmt of Generator l p e -> case srcInfoPoints l of [a] -> do exactP p printStringAt (pos a) "<-" exactPC e _ -> errorEP "ExactP: Stmt: Generator is given wrong number of srcInfoPoints" Qualifier l e -> exactP e LetStmt l bds -> do printString "let" exactPC bds RecStmt l ss -> case srcInfoPoints l of a:pts -> do printString "rec" layoutList pts ss _ -> errorEP "ExactP: Stmt: RecStmt is given too few srcInfoPoints" instance ExactP QualStmt where exactP qstmt = case qstmt of QualStmt l stmt -> exactP stmt ThenTrans l e -> printString "then" >> exactPC e ThenBy l e1 e2 -> do case srcInfoPoints l of [a,b] -> do printString "then" exactPC e1 printStringAt (pos b) "by" exactPC e2 _ -> errorEP "ExactP: QualStmt: ThenBy is given wrong number of srcInfoPoints" GroupBy l e -> do printStrs $ zip (srcInfoPoints l) ["then","group","by"] exactPC e GroupUsing l e -> do printStrs $ zip (srcInfoPoints l) ["then","group","using"] exactPC e GroupByUsing l e1 e2 -> do let pts = srcInfoPoints l printStrs $ zip (init pts) ["then","group","by"] exactPC e1 printStringAt (pos (last pts)) "using" exactPC e2 instance ExactP Bracket where exactP br = case br of ExpBracket l e -> case srcInfoPoints l of [a,b] -> do printString "[|" exactPC e printStringAt (pos b) "|]" _ -> errorEP "ExactP: Bracket: ExpBracket is given wrong number of srcInfoPoints" PatBracket l p -> case srcInfoPoints l of [a,b] -> do printString "[p|" exactPC p printStringAt (pos b) "|]" _ -> errorEP "ExactP: Bracket: PatBracket is given wrong number of srcInfoPoints" TypeBracket l t -> do case srcInfoPoints l of [a,b] -> do printString "[t|" exactPC t printStringAt (pos b) "|]" _ -> errorEP "ExactP: Bracket: TypeBracket is given wrong number of srcInfoPoints" DeclBracket l ds -> case srcInfoPoints l of a:pts -> do printString "[d|" layoutList (init pts) (sepFunBinds ds) printStringAt (pos (last pts)) "|]" _ -> errorEP "ExactP: Bracket: DeclBracket is given too few srcInfoPoints" instance ExactP XAttr where exactP (XAttr l xn e) = case srcInfoPoints l of [a] -> do exactP xn printStringAt (pos a) "=" exactPC e _ -> errorEP "ExactP: XAttr is given wrong number of srcInfoPoints" instance ExactP Alt where exactP (Alt l p galts mbs) = do exactP p exactPC galts maybeEP (\bs -> printStringAt (pos (head (srcInfoPoints l))) "where" >> exactPC bs) mbs instance ExactP GuardedAlts where exactP (UnGuardedAlt l e) = printString "->" >> exactPC e exactP (GuardedAlts l galts) = mapM_ exactPC galts instance ExactP GuardedAlt where exactP (GuardedAlt l stmts e) = do bracketList ("|",",","->") (srcInfoPoints l) stmts exactPC e instance ExactP Match where exactP (Match l n ps rhs mbinds) = do let pts = srcInfoPoints l len = length pts pars = len `div` 2 (oPars,cParsWh) = splitAt pars pts (cPars,whPt) = splitAt pars cParsWh -- whPt is either singleton or empty printStrs (zip oPars (repeat "(")) exactPC n printStreams (zip (map pos cPars) (repeat $ printString ")")) (map (pos . ann &&& exactPC) ps) exactPC rhs maybeEP (\bds -> printStringAt (pos (head pts)) "where" >> exactPC bds) mbinds exactP (InfixMatch l a n bs rhs mbinds) = do let pts = srcInfoPoints l len = length pts pars = len `div` 2 (oPars,cParsWh) = splitAt pars pts (cPars,whPt) = splitAt pars cParsWh -- whPt is either singleton or empty printStrs (zip oPars (repeat "(")) exactPC a epInfixName n printInterleaved' (zip cPars (repeat ")")) bs exactPC rhs maybeEP (\bds -> printStringAt (pos (head whPt)) "where" >> exactPC bds) mbinds instance ExactP Rhs where exactP (UnGuardedRhs l e) = printString "=" >> exactPC e exactP (GuardedRhss l grhss) = mapM_ exactPC grhss instance ExactP GuardedRhs where exactP (GuardedRhs l ss e) = case srcInfoPoints l of a:pts -> do printString "|" printInterleaved' (zip (init pts) (repeat ",") ++ [(last pts, "=")]) ss exactPC e _ -> errorEP "ExactP: GuardedRhs is given wrong number of srcInfoPoints" instance ExactP Pat where exactP pat = case pat of PVar l n -> exactP n PLit l lit -> exactP lit PNeg l p -> printString "-" >> exactPC p PNPlusK l n k -> case srcInfoPoints l of [a,b] -> do exactP n printStringAt (pos a) "+" printStringAt (pos b) (show k) _ -> errorEP "ExactP: Pat: PNPlusK is given wrong number of srcInfoPoints" PInfixApp l pa qn pb -> exactP pa >> epInfixQName qn >> exactPC pb PApp l qn ps -> exactP qn >> mapM_ exactPC ps PTuple l bx ps -> case bx of Boxed -> parenList (srcInfoPoints l) ps Unboxed -> parenHashList (srcInfoPoints l) ps PList l ps -> squareList (srcInfoPoints l) ps PParen l p -> parenList (srcInfoPoints l) [p] PRec l qn pfs -> exactP qn >> curlyList (srcInfoPoints l) pfs PAsPat l n p -> case srcInfoPoints l of [a] -> do exactP n printStringAt (pos a) "@" exactPC p _ -> errorEP "ExactP: Pat: PAsPat is given wrong number of srcInfoPoints" PWildCard l -> printString "_" PIrrPat l p -> printString "~" >> exactPC p PatTypeSig l p t -> case srcInfoPoints l of [a] -> do exactP p printStringAt (pos a) "::" exactPC t _ -> errorEP "ExactP: Pat: PatTypeSig is given wrong number of srcInfoPoints" PViewPat l e p -> case srcInfoPoints l of [a] -> do exactP e printStringAt (pos a) "->" exactPC p _ -> errorEP "ExactP: Pat: PViewPat is given wrong number of srcInfoPoints" PRPat l rps -> squareList (srcInfoPoints l) rps PXTag l xn attrs mat ps -> case srcInfoPoints l of [a,b,c,d,e] -> do printString "<" exactPC xn mapM_ exactPC attrs maybeEP exactPC mat printStringAt (pos b) ">" mapM_ exactPC ps printStringAt (pos c) "" -- Optional semi [a,b,semi,c,d,e] -> do printString "<" exactPC xn mapM_ exactPC attrs maybeEP exactPC mat printStringAt (pos b) ">" mapM_ exactPC ps printSemi semi printStringAt (pos c) "" _ -> errorEP "ExactP: Pat: PXTag is given wrong number of srcInfoPoints" PXETag l xn attrs mat -> case srcInfoPoints l of [a,b] -> do printString "<" exactPC xn mapM_ exactPC attrs maybeEP exactPC mat printStringAt (pos b) "/>" _ -> errorEP "ExactP: Pat: PXETag is given wrong number of srcInfoPoints" PXPcdata l str -> printString str PXPatTag l p -> case srcInfoPoints l of [a,b] -> do printString "<%" exactPC p printString "%>" _ -> errorEP "ExactP: Pat: PXPatTag is given wrong number of srcInfoPoints" PXRPats l rps -> bracketList ("<[",",","]>") (srcInfoPoints l) rps PExplTypeArg l qn t -> case srcInfoPoints l of [a,b] -> do exactP qn printStringAt (pos a) "{|" exactPC t printStringAt (pos b) "|}" _ -> errorEP "ExactP: Pat: PExplTypeArg is given wrong number of srcInfoPoints" PQuasiQuote l name qt -> printString $ "[$" ++ name ++ "|" ++ qt ++ "]" PBangPat l p -> printString "!" >> exactPC p instance ExactP PatField where exactP pf = case pf of PFieldPat l qn p -> case srcInfoPoints l of [a] -> do exactP qn printStringAt (pos a) "=" exactPC p _ -> errorEP "ExactP: PatField: PFieldPat is given wrong number of srcInfoPoints" PFieldPun l n -> exactP n PFieldWildcard l -> printString ".." instance ExactP RPat where exactP rpat = case rpat of RPOp l rp op -> exactP rp >> exactPC op RPEither l r1 r2 -> case srcInfoPoints l of [a] -> do exactP r1 printStringAt (pos a) "|" exactPC r2 _ -> errorEP "ExactP: RPat: RPEither is given wrong number of srcInfoPoints" RPSeq l rps -> bracketList ("(|",",","|)") (srcInfoPoints l) rps RPGuard l p stmts -> case srcInfoPoints l of a:pts -> do printString "(|" exactPC p bracketList ("|",",","|)") pts stmts _ -> errorEP "ExactP: RPat: RPGuard is given wrong number of srcInfoPoints" RPCAs l n rp -> case srcInfoPoints l of [a] -> do exactP n printStringAt (pos a) "@:" exactPC rp _ -> errorEP "ExactP: RPat: RPCAs is given wrong number of srcInfoPoints" RPAs l n rp -> case srcInfoPoints l of [a] -> do exactP n printStringAt (pos a) "@" exactPC rp _ -> errorEP "ExactP: RPat: RPAs is given wrong number of srcInfoPoints" RPParen l rp -> do parenList (srcInfoPoints l) [rp] RPPat l p -> exactP p instance ExactP RPatOp where exactP rop = printString $ case rop of RPStar l -> "*" RPStarG l -> "*!" RPPlus l -> "+" RPPlusG l -> "+!" RPOpt l -> "?" RPOptG l -> "?!" instance ExactP PXAttr where exactP (PXAttr l xn p) = case srcInfoPoints l of [a] -> do exactP xn printStringAt (pos a) "=" exactPC p _ -> errorEP "ExactP: PXAttr is given wrong number of srcInfoPoints" instance ExactP XName where exactP xn = case xn of XName l name -> printString name XDomName l dom name -> case srcInfoPoints l of [a,b,c] -> do printString dom printStringAt (pos b) ":" printStringAt (pos c) name _ -> errorEP "ExactP: XName: XDomName is given wrong number of srcInfoPoints" instance ExactP Binds where exactP (BDecls l ds) = layoutList (srcInfoPoints l) (sepFunBinds ds) exactP (IPBinds l ips) = layoutList (srcInfoPoints l) ips instance ExactP CallConv where exactP (StdCall _) = printString "stdcall" exactP (CCall _) = printString "ccall" exactP (CPlusPlus _) = printString "cplusplus" exactP (DotNet _) = printString "dotnet" exactP (Jvm _) = printString "jvm" exactP (Js _) = printString "js" exactP (CApi _) = printString "capi" instance ExactP Safety where exactP (PlayRisky _) = printString "unsafe" exactP (PlaySafe _ b) = printString $ if b then "threadsafe" else "safe" exactP (PlayInterruptible _) = printString "interruptible" instance ExactP Rule where exactP (Rule l str mact mrvs e1 e2) = case srcInfoPoints l of a:pts -> do printString (show str) maybeEP exactP mact pts <- case mrvs of Nothing -> return pts Just rvs -> case pts of a:b:pts' -> do printStringAt (pos a) "forall" mapM_ exactPC rvs printStringAt (pos b) "." return pts' _ -> errorEP "ExactP: Rule is given too few srcInfoPoints" case pts of [x] -> do exactPC e1 printStringAt (pos x) "=" exactPC e2 _ -> errorEP "ExactP: Rule is given wrong number of srcInfoPoints" _ -> errorEP "ExactP: Rule is given too few srcInfoPoints" instance ExactP RuleVar where exactP (TypedRuleVar l n t) = do case srcInfoPoints l of [a,b,c] -> do printString "(" exactPC n printStringAt (pos b) "::" exactPC t printStringAt (pos c) ")" _ -> errorEP "ExactP: RuleVar: TypedRuleVar is given wrong number of srcInfoPoints" exactP (RuleVar l n) = exactP n instance ExactP Activation where exactP (ActiveFrom l i) = printPoints l ["[", show i, "]"] exactP (ActiveUntil l i) = printPoints l ["[", "~", show i, "]"] instance ExactP FieldDecl where exactP (FieldDecl l ns bt) = do let pts = srcInfoPoints l printInterleaved' (zip (init pts) (repeat ",") ++ [(last pts, "::")]) ns exactPC bt instance ExactP IPBind where exactP (IPBind l ipn e) = do case srcInfoPoints l of [a] -> do exactP ipn printStringAt (pos a) "=" exactPC e _ -> errorEP "ExactP: IPBind is given wrong number of srcInfoPoints" haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Annotated/Fixity.hs0000644000000000000000000004074712204617765023547 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Annotated.Fixity -- Copyright : (c) Niklas Broberg 2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : stable -- Portability : portable -- -- Fixity information to give the parser so that infix operators can -- be parsed properly. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Annotated.Fixity ( -- * Fixity representation Fixity(..) -- | The following three functions all create lists of -- fixities from textual representations of operators. -- The intended usage is e.g. -- -- > fixs = infixr_ 0 ["$","$!","`seq`"] -- -- Note that the operators are expected as you would -- write them infix, i.e. with ` characters surrounding -- /varid/ operators, and /varsym/ operators written as is. , infix_, infixl_, infixr_ -- ** Collections of fixities , preludeFixities, baseFixities -- * Applying fixities to an AST , AppFixity(..) ) where import Language.Haskell.Exts.Annotated.Syntax import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.ParseMonad (ParseResult(..)) import Language.Haskell.Exts.Fixity ( Fixity(..), infix_, infixl_, infixr_, preludeFixities, baseFixities, prefixMinusFixity ) import qualified Language.Haskell.Exts.Syntax as S ( Assoc(..), QOp(..), Op(..), QName(..), Name(..), SpecialCon(..), ModuleName ) import Language.Haskell.Exts.Annotated.Simplify ( sQOp, sOp, sAssoc, sQName, sModuleHead, sName ) import Data.Char (isUpper) import Control.Monad (when, (<=<), liftM, liftM2, liftM3, liftM4) import Data.Traversable (mapM) import Prelude hiding (mapM) -- | All AST elements that may include expressions which in turn may -- need fixity tweaking will be instances of this class. class AppFixity ast where -- | Tweak any expressions in the element to account for the -- fixities given. Assumes that all operator expressions are -- fully left associative chains to begin with. applyFixities :: Monad m => [Fixity] -- ^ The fixities to account for. -> ast SrcSpanInfo -- ^ The element to tweak. -> m (ast SrcSpanInfo) -- ^ The same element, but with operator expressions updated, or a failure. instance AppFixity Exp where applyFixities fixs = infFix fixs <=< leafFix fixs where -- This is the real meat case. We can assume a left-associative list to begin with. infFix fixs (InfixApp l2 a op2 z) = do e <- infFix fixs a let fixup (a1,p1) (a2,p2) l1 y pre = do when (p1 == p2 && (a1 /= a2 || a1 == S.AssocNone)) -- Ambiguous infix expression! $ fail "Ambiguous infix expression" if (p1 > p2 || p1 == p2 && (a1 == S.AssocLeft || a2 == S.AssocNone)) -- Already right order then return $ InfixApp l2 e op2 z else liftM pre (infFix fixs $ InfixApp (ann y <++> ann z) y op2 z) case e of InfixApp l1 x op1 y -> fixup (askFixity fixs op1) (askFixity fixs op2) l1 y (InfixApp l2 x op1) NegApp l1 y -> fixup prefixMinusFixity (askFixity fixs op2) l1 y (NegApp l2) _ -> return $ InfixApp l2 e op2 z infFix _ e = return e --ambOps l = ParseFailed (getPointLoc l) $ "Ambiguous infix expression" instance AppFixity Pat where applyFixities fixs = infFix fixs <=< leafFixP fixs where -- This is the real meat case. We can assume a left-associative list to begin with. infFix fixs (PInfixApp l2 a op2 z) = do p <- infFix fixs a let fixup (a1,p1) (a2,p2) l1 y pre = do when (p1 == p2 && (a1 /= a2 || a1 == S.AssocNone )) -- Ambiguous infix expression! $ fail "Ambiguous infix expression" if (p1 > p2 || p1 == p2 && (a1 == S.AssocLeft || a2 == S.AssocNone)) -- Already right order then return $ PInfixApp l2 p op2 z else liftM pre (infFix fixs $ PInfixApp (ann y <++> ann z) y op2 z) case p of PInfixApp l1 x op1 y -> fixup (askFixityP fixs op1) (askFixityP fixs op2) l1 y (PInfixApp l2 x op1) PNeg l1 y -> fixup prefixMinusFixity (askFixityP fixs op2) l1 y (PNeg l2) _ -> return $ PInfixApp l2 p op2 z infFix _ p = return p -- Internal: lookup associativity and precedence of an operator askFixity :: [Fixity] -> QOp l -> (S.Assoc, Int) askFixity xs k = askFix xs (f $ sQOp k) -- undefined -- \k -> askFixityP xs (f k) -- lookupWithDefault (AssocLeft, 9) (f k) mp where f (S.QVarOp x) = g x f (S.QConOp x) = g x g (S.Special S.Cons) = S.UnQual (S.Symbol ":") g x = x -- Same using patterns askFixityP :: [Fixity] -> QName l -> (S.Assoc, Int) askFixityP xs qn = askFix xs (g $ sQName qn) where g (S.Special S.Cons) = S.UnQual (S.Symbol ":") g x = x askFix :: [Fixity] -> S.QName -> (S.Assoc, Int) askFix xs = \k -> lookupWithDefault (S.AssocLeft, 9) k mp where lookupWithDefault def k mp = case lookup k mp of Nothing -> def Just x -> x mp = [(x,(a,p)) | Fixity a p x <- xs] ------------------------------------------------------------------- -- Boilerplate - yuck!! Everything below here is internal stuff instance AppFixity Module where applyFixities fixs (Module l mmh prs imp decls) = liftM (Module l mmh prs imp) $ appFixDecls (Just mn) fixs decls where (mn, _, _) = sModuleHead mmh applyFixities fixs (XmlPage l mn os xn xas mexp cs) = liftM3 (XmlPage l mn os xn) (fix xas) (fix mexp) (fix cs) where fix xs = mapM (applyFixities fixs) xs applyFixities fixs (XmlHybrid l mmh prs imp decls xn xas mexp cs) = liftM4 (flip (XmlHybrid l mmh prs imp) xn) (appFixDecls (Just mn) fixs decls) (fixe xas) (fixe mexp) (fixe cs) where fixe xs = let extraFixs = getFixities (Just mn) decls in mapM (applyFixities (fixs++extraFixs)) xs (mn, _, _) = sModuleHead mmh instance AppFixity Decl where applyFixities fixs decl = case decl of ClassDecl l ctxt dh deps cdecls -> liftM (ClassDecl l ctxt dh deps) $ mapM (mapM fix) cdecls InstDecl l ctxt ih idecls -> liftM (InstDecl l ctxt ih) $ mapM (mapM fix) idecls SpliceDecl l spl -> liftM (SpliceDecl l) $ fix spl FunBind l matches -> liftM (FunBind l) $ mapM fix matches PatBind l p mt rhs bs -> liftM3 (flip (PatBind l) mt) (fix p) (fix rhs) (mapM fix bs) AnnPragma l ann -> liftM (AnnPragma l) $ fix ann _ -> return decl where fix x = applyFixities fixs x appFixDecls :: Monad m => Maybe S.ModuleName -> [Fixity] -> [Decl SrcSpanInfo] -> m [Decl SrcSpanInfo] appFixDecls mmdl fixs decls = let extraFixs = getFixities mmdl decls in mapM (applyFixities (fixs++extraFixs)) decls getFixities mmdl = concatMap (getFixity mmdl) getFixity mmdl (InfixDecl _ a mp ops) = let p = maybe 9 id mp in map (Fixity (sAssoc a) p) (concatMap g ops) where g (VarOp l x) = f $ sName x g (ConOp l x) = f $ sName x f x = case mmdl of Nothing -> [ S.UnQual x] Just m -> [S.Qual m x, S.UnQual x] getFixity _ _ = [] instance AppFixity Annotation where applyFixities fixs ann = case ann of Ann l n e -> liftM (Ann l n) $ fix e TypeAnn l n e -> liftM (TypeAnn l n) $ fix e ModuleAnn l e -> liftM (ModuleAnn l) $ fix e where fix x = applyFixities fixs x instance AppFixity ClassDecl where applyFixities fixs (ClsDecl l decl) = liftM (ClsDecl l) $ applyFixities fixs decl applyFixities _ cdecl = return cdecl instance AppFixity InstDecl where applyFixities fixs (InsDecl l decl) = liftM (InsDecl l) $ applyFixities fixs decl applyFixities _ idecl = return idecl instance AppFixity Match where applyFixities fixs match = case match of Match l n ps rhs bs -> liftM3 (Match l n) (mapM fix ps) (fix rhs) (mapM fix bs) InfixMatch l a n ps rhs bs -> liftM4 (flip (InfixMatch l) n) (fix a) (mapM fix ps) (fix rhs) (mapM fix bs) where fix x = applyFixities fixs x instance AppFixity Rhs where applyFixities fixs rhs = case rhs of UnGuardedRhs l e -> liftM (UnGuardedRhs l) $ fix e GuardedRhss l grhss -> liftM (GuardedRhss l) $ mapM fix grhss where fix x = applyFixities fixs x instance AppFixity GuardedRhs where applyFixities fixs (GuardedRhs l stmts e) = liftM2 (GuardedRhs l) (mapM fix stmts) $ fix e where fix x = applyFixities fixs x instance AppFixity PatField where applyFixities fixs (PFieldPat l n p) = liftM (PFieldPat l n) $ applyFixities fixs p applyFixities _ pf = return pf instance AppFixity RPat where applyFixities fixs rp = case rp of RPOp l rp op -> liftM (flip (RPOp l) op) $ fix rp RPEither l a b -> liftM2 (RPEither l) (fix a) (fix b) RPSeq l rps -> liftM (RPSeq l) $ mapM fix rps RPGuard l p stmts -> liftM2 (RPGuard l) (fix p) $ mapM fix stmts RPCAs l n rp -> liftM (RPCAs l n) $ fix rp RPAs l n rp -> liftM (RPAs l n) $ fix rp RPParen l rp -> liftM (RPParen l) $ fix rp RPPat l p -> liftM (RPPat l) $ fix p where fix x = applyFixities fixs x instance AppFixity PXAttr where applyFixities fixs (PXAttr l n p) = liftM (PXAttr l n) $ applyFixities fixs p instance AppFixity Stmt where applyFixities fixs stmt = case stmt of Generator l p e -> liftM2 (Generator l) (fix p) (fix e) Qualifier l e -> liftM (Qualifier l) $ fix e LetStmt l bs -> liftM (LetStmt l) $ fix bs -- special behavior RecStmt l stmts -> liftM (RecStmt l) $ mapM fix stmts where fix x = applyFixities fixs x instance AppFixity Binds where applyFixities fixs bs = case bs of BDecls l decls -> liftM (BDecls l) $ appFixDecls Nothing fixs decls -- special behavior IPBinds l ips -> liftM (IPBinds l) $ mapM fix ips where fix x = applyFixities fixs x instance AppFixity IPBind where applyFixities fixs (IPBind l n e) = liftM (IPBind l n) $ applyFixities fixs e instance AppFixity FieldUpdate where applyFixities fixs (FieldUpdate l n e) = liftM (FieldUpdate l n) $ applyFixities fixs e applyFixities _ fup = return fup instance AppFixity Alt where applyFixities fixs (Alt l p galts bs) = liftM3 (Alt l) (fix p) (fix galts) (mapM fix bs) where fix x = applyFixities fixs x instance AppFixity GuardedAlts where applyFixities fixs galts = case galts of UnGuardedAlt l e -> liftM (UnGuardedAlt l) $ fix e GuardedAlts l galts -> liftM (GuardedAlts l) $ mapM fix galts where fix x = applyFixities fixs x instance AppFixity GuardedAlt where applyFixities fixs (GuardedAlt l stmts e) = liftM2 (GuardedAlt l) (mapM fix stmts) (fix e) where fix x = applyFixities fixs x instance AppFixity QualStmt where applyFixities fixs qstmt = case qstmt of QualStmt l s -> liftM (QualStmt l) $ fix s ThenTrans l e -> liftM (ThenTrans l) $ fix e ThenBy l e1 e2 -> liftM2 (ThenBy l) (fix e1) (fix e2) GroupBy l e -> liftM (GroupBy l) (fix e) GroupUsing l e -> liftM (GroupUsing l) (fix e) GroupByUsing l e1 e2 -> liftM2 (GroupByUsing l) (fix e1) (fix e2) where fix x = applyFixities fixs x instance AppFixity Bracket where applyFixities fixs br = case br of ExpBracket l e -> liftM (ExpBracket l) $ fix e PatBracket l p -> liftM (PatBracket l) $ fix p DeclBracket l ds -> liftM (DeclBracket l) $ mapM fix ds _ -> return br where fix x = applyFixities fixs x instance AppFixity Splice where applyFixities fixs (ParenSplice l e) = liftM (ParenSplice l) $ applyFixities fixs e applyFixities _ s = return s instance AppFixity XAttr where applyFixities fixs (XAttr l n e) = liftM (XAttr l n) $ applyFixities fixs e -- the boring boilerplate stuff for expressions too -- Recursively fixes the "leaves" of the infix chains, -- without yet touching the chain itself. We assume all chains are -- left-associate to begin with. leafFix fixs e = case e of InfixApp l e1 op e2 -> liftM2 (flip (InfixApp l) op) (leafFix fixs e1) (fix e2) App l e1 e2 -> liftM2 (App l) (fix e1) (fix e2) NegApp l e -> liftM (NegApp l) $ fix e Lambda l pats e -> liftM2 (Lambda l) (mapM fix pats) $ fix e Let l bs e -> liftM2 (Let l) (fix bs) $ fix e If l e a b -> liftM3 (If l) (fix e) (fix a) (fix b) Case l e alts -> liftM2 (Case l) (fix e) $ mapM fix alts Do l stmts -> liftM (Do l) $ mapM fix stmts MDo l stmts -> liftM (MDo l) $ mapM fix stmts Tuple l bx exps -> liftM (Tuple l bx) $ mapM fix exps List l exps -> liftM (List l) $ mapM fix exps Paren l e -> liftM (Paren l) $ fix e LeftSection l e op -> liftM (flip (LeftSection l) op) (fix e) RightSection l op e -> liftM (RightSection l op) $ fix e RecConstr l n fups -> liftM (RecConstr l n) $ mapM fix fups RecUpdate l e fups -> liftM2 (RecUpdate l) (fix e) $ mapM fix fups EnumFrom l e -> liftM (EnumFrom l) $ fix e EnumFromTo l e1 e2 -> liftM2 (EnumFromTo l) (fix e1) (fix e2) EnumFromThen l e1 e2 -> liftM2 (EnumFromThen l) (fix e1) (fix e2) EnumFromThenTo l e1 e2 e3 -> liftM3 (EnumFromThenTo l) (fix e1) (fix e2) (fix e3) ListComp l e quals -> liftM2 (ListComp l) (fix e) $ mapM fix quals ParComp l e qualss -> liftM2 (ParComp l) (fix e) $ mapM (mapM fix) qualss ExpTypeSig l e t -> liftM (flip (ExpTypeSig l) t) (fix e) BracketExp l b -> liftM (BracketExp l) $ fix b SpliceExp l s -> liftM (SpliceExp l) $ fix s XTag l n ats mexp cs -> liftM3 (XTag l n) (mapM fix ats) (mapM fix mexp) (mapM fix cs) XETag l n ats mexp -> liftM2 (XETag l n) (mapM fix ats) (mapM fix mexp) XExpTag l e -> liftM (XExpTag l) $ fix e XChildTag l cs -> liftM (XChildTag l) $ mapM fix cs Proc l p e -> liftM2 (Proc l) (fix p) (fix e) LeftArrApp l e1 e2 -> liftM2 (LeftArrApp l) (fix e1) (fix e2) RightArrApp l e1 e2 -> liftM2 (RightArrApp l) (fix e1) (fix e2) LeftArrHighApp l e1 e2 -> liftM2 (LeftArrHighApp l) (fix e1) (fix e2) RightArrHighApp l e1 e2 -> liftM2 (RightArrHighApp l) (fix e1) (fix e2) CorePragma l s e -> liftM (CorePragma l s) (fix e) SCCPragma l s e -> liftM (SCCPragma l s) (fix e) GenPragma l s ab cd e -> liftM (GenPragma l s ab cd) (fix e) _ -> return e where fix x = applyFixities fixs x leafFixP fixs p = case p of PInfixApp l p1 op p2 -> liftM2 (flip (PInfixApp l) op) (leafFixP fixs p1) (fix p2) PNeg l p -> liftM (PNeg l) $ fix p PApp l n ps -> liftM (PApp l n) $ mapM fix ps PTuple l bx ps -> liftM (PTuple l bx) $ mapM fix ps PList l ps -> liftM (PList l) $ mapM fix ps PParen l p -> liftM (PParen l) $ fix p PRec l n pfs -> liftM (PRec l n) $ mapM fix pfs PAsPat l n p -> liftM (PAsPat l n) $ fix p PIrrPat l p -> liftM (PIrrPat l) $ fix p PatTypeSig l p t -> liftM (flip (PatTypeSig l) t) (fix p) PViewPat l e p -> liftM2 (PViewPat l) (fix e) (fix p) PRPat l rps -> liftM (PRPat l) $ mapM fix rps PXTag l n ats mp ps -> liftM3 (PXTag l n) (mapM fix ats) (mapM fix mp) (mapM fix ps) PXETag l n ats mp -> liftM2 (PXETag l n) (mapM fix ats) (mapM fix mp) PXPatTag l p -> liftM (PXPatTag l) $ fix p PXRPats l rps -> liftM (PXRPats l) $ mapM fix rps PBangPat l p -> liftM (PBangPat l) $ fix p _ -> return p where fix x = applyFixities fixs x haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Annotated/Simplify.hs0000644000000000000000000005745712204617765024075 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Annotated.Simplify -- Copyright : (c) Niklas Broberg 2009 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : experimental -- Portability : portable -- -- This module contains code for translating from the annotated -- complex AST in Language.Haskell.Exts.Annotated.Syntax -- to the simpler, sparsely annotated AST in Language.Haskell.Exts.Syntax. -- -- A function @sXYZ@ translates an annotated AST node of type @XYZ l@ into -- a simple AST node of type @XYZ@. I would have prefered to use a MPTC -- with an fd/type family to get a single exported function name, but -- I wish to stay Haskell 2010 compliant. Let's hope for Haskell 2011. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Annotated.Simplify where import Language.Haskell.Exts.Annotated.Syntax import qualified Language.Haskell.Exts.Syntax as S import Language.Haskell.Exts.SrcLoc -- | Translate an annotated AST node representing a Haskell module, into -- a simpler version that retains (almost) only abstract information. -- In particular, XML and hybrid XML pages enabled by the XmlSyntax extension -- are translated into standard Haskell modules with a @page@ function. sModule :: SrcInfo loc => Module loc -> S.Module sModule md = case md of Module l mmh oss ids ds -> let (mn, mwt, mes) = sModuleHead mmh in S.Module (getPointLoc l) mn (map sModulePragma oss) mwt mes (map sImportDecl ids) (map sDecl ds) XmlPage l mn oss xn attrs mat es -> let loc = getPointLoc l in S.Module loc (sModuleName mn) (map sModulePragma oss) Nothing (Just [S.EVar $ S.UnQual $ S.Ident "page"]) [] [pageFun loc $ S.XTag loc (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)] XmlHybrid l mmh oss ids ds xn attrs mat es -> let loc1 = getPointLoc l loc2 = getPointLoc (ann xn) (mn, mwt, mes) = sModuleHead mmh in S.Module loc1 mn (map sModulePragma oss) mwt mes (map sImportDecl ids) (map sDecl ds ++ [pageFun loc2 $ S.XTag loc2 (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)]) where pageFun :: SrcLoc -> S.Exp -> S.Decl pageFun loc e = S.PatBind loc namePat Nothing rhs (S.BDecls []) where namePat = S.PVar $ S.Ident "page" rhs = S.UnGuardedRhs e -- | Translate an annotated AST node representing a Haskell declaration -- into a simpler version. Note that in the simpler version, all declaration -- nodes are still annotated by 'SrcLoc's. sDecl :: SrcInfo loc => Decl loc -> S.Decl sDecl decl = case decl of TypeDecl l dh t -> let (n, tvs) = sDeclHead dh in S.TypeDecl (getPointLoc l) n tvs (sType t) TypeFamDecl l dh mk -> let (n, tvs) = sDeclHead dh in S.TypeFamDecl (getPointLoc l) n tvs (fmap sKind mk) DataDecl l dn mctxt dh constrs mder -> let (n, tvs) = sDeclHead dh in S.DataDecl (getPointLoc l) (sDataOrNew dn) (maybe [] sContext mctxt) n tvs (map sQualConDecl constrs) (maybe [] sDeriving mder) GDataDecl l dn mctxt dh mk gds mder -> let (n, tvs) = sDeclHead dh in S.GDataDecl (getPointLoc l) (sDataOrNew dn) (maybe [] sContext mctxt) n tvs (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder) DataFamDecl l mctxt dh mk -> let (n, tvs) = sDeclHead dh in S.DataFamDecl (getPointLoc l) (maybe [] sContext mctxt) n tvs (fmap sKind mk) TypeInsDecl l t1 t2 -> S.TypeInsDecl (getPointLoc l) (sType t1) (sType t2) DataInsDecl l dn t constrs mder -> S.DataInsDecl (getPointLoc l) (sDataOrNew dn) (sType t) (map sQualConDecl constrs) (maybe [] sDeriving mder) GDataInsDecl l dn t mk gds mder -> S.GDataInsDecl (getPointLoc l) (sDataOrNew dn) (sType t) (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder) ClassDecl l mctxt dh fds mcds -> let (n, tvs) = sDeclHead dh in S.ClassDecl (getPointLoc l) (maybe [] sContext mctxt) n tvs (map sFunDep fds) (maybe [] (map sClassDecl) mcds) InstDecl l mctxt ih mids -> let (qn, ts) = sInstHead ih in S.InstDecl (getPointLoc l) (maybe [] sContext mctxt) qn ts (maybe [] (map sInstDecl) mids) DerivDecl l mctxt ih -> let (qn, ts) = sInstHead ih in S.DerivDecl (getPointLoc l) (maybe [] sContext mctxt) qn ts InfixDecl l ass prec ops -> S.InfixDecl (getPointLoc l) (sAssoc ass) (maybe 9 id prec) (map sOp ops) DefaultDecl l ts -> S.DefaultDecl (getPointLoc l) (map sType ts) SpliceDecl l sp -> S.SpliceDecl (getPointLoc l) (sExp sp) TypeSig l ns t -> S.TypeSig (getPointLoc l) (map sName ns) (sType t) FunBind _ ms -> S.FunBind (map sMatch ms) PatBind l p mt rhs mbs -> S.PatBind (getPointLoc l) (sPat p) (fmap sType mt) (sRhs rhs) (maybe (S.BDecls []) sBinds mbs) ForImp l cc msaf mstr n t -> S.ForImp (getPointLoc l) (sCallConv cc) (maybe (S.PlaySafe False) sSafety msaf) (maybe "" id mstr) (sName n) (sType t) ForExp l cc mstr n t -> S.ForExp (getPointLoc l) (sCallConv cc) (maybe "" id mstr) (sName n) (sType t) RulePragmaDecl l rs -> S.RulePragmaDecl (getPointLoc l) (map sRule rs) DeprPragmaDecl l nsstrs -> S.DeprPragmaDecl (getPointLoc l) (map (\(ns, str) -> (map sName ns, str)) nsstrs) WarnPragmaDecl l nsstrs -> S.WarnPragmaDecl (getPointLoc l) (map (\(ns, str) -> (map sName ns, str)) nsstrs) InlineSig l b mact qn -> S.InlineSig (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn) InlineConlikeSig l mact qn -> S.InlineConlikeSig (getPointLoc l) (maybe S.AlwaysActive sActivation mact) (sQName qn) SpecSig l mact qn ts -> S.SpecSig (getPointLoc l) (maybe S.AlwaysActive sActivation mact) (sQName qn) (map sType ts) SpecInlineSig l b mact qn ts -> S.SpecInlineSig (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn) (map sType ts) InstSig l mctxt ih -> let (qn, ts) = sInstHead ih in S.InstSig (getPointLoc l) (maybe [] sContext mctxt) qn ts AnnPragma l ann -> S.AnnPragma (getPointLoc l) (sAnnotation ann) sAnnotation :: SrcInfo loc => Annotation loc -> S.Annotation sAnnotation ann = case ann of Ann _ n e -> S.Ann (sName n) (sExp e) TypeAnn _ n e -> S.TypeAnn (sName n) (sExp e) ModuleAnn _ e -> S.ModuleAnn (sExp e) sModuleName :: ModuleName l -> S.ModuleName sModuleName (ModuleName _ str) = S.ModuleName str sSpecialCon :: SpecialCon l -> S.SpecialCon sSpecialCon sc = case sc of UnitCon _ -> S.UnitCon ListCon _ -> S.ListCon FunCon _ -> S.FunCon TupleCon _ b k -> S.TupleCon b k Cons _ -> S.Cons UnboxedSingleCon _ -> S.UnboxedSingleCon sQName :: QName l -> S.QName sQName qn = case qn of Qual _ mn n -> S.Qual (sModuleName mn) (sName n) UnQual _ n -> S.UnQual (sName n) Special _ sc -> S.Special (sSpecialCon sc) sName :: Name l -> S.Name sName (Ident _ str) = S.Ident str sName (Symbol _ str) = S.Symbol str sIPName :: IPName l -> S.IPName sIPName (IPDup _ str) = S.IPDup str sIPName (IPLin _ str) = S.IPLin str sQOp :: QOp l -> S.QOp sQOp (QVarOp _ qn) = S.QVarOp (sQName qn) sQOp (QConOp _ qn) = S.QConOp (sQName qn) sOp :: Op l -> S.Op sOp (VarOp _ n) = S.VarOp (sName n) sOp (ConOp _ n) = S.ConOp (sName n) sCName :: CName l -> S.CName sCName (VarName _ n) = S.VarName (sName n) sCName (ConName _ n) = S.ConName (sName n) sModuleHead :: Maybe (ModuleHead l) -> (S.ModuleName, Maybe (S.WarningText), Maybe [S.ExportSpec]) sModuleHead mmh = case mmh of Nothing -> (S.main_mod, Nothing, Just [S.EVar (S.UnQual S.main_name)]) Just (ModuleHead _ mn mwt mel) -> (sModuleName mn, fmap sWarningText mwt, fmap sExportSpecList mel) sExportSpecList :: ExportSpecList l -> [S.ExportSpec] sExportSpecList (ExportSpecList _ ess) = map sExportSpec ess sExportSpec :: ExportSpec l -> S.ExportSpec sExportSpec es = case es of EVar _ qn -> S.EVar (sQName qn) EAbs _ qn -> S.EAbs (sQName qn) EThingAll _ qn -> S.EThingAll (sQName qn) EThingWith _ qn cns -> S.EThingWith (sQName qn) (map sCName cns) EModuleContents _ mn -> S.EModuleContents (sModuleName mn) sImportDecl :: SrcInfo loc => ImportDecl loc -> S.ImportDecl sImportDecl (ImportDecl l mn qu src mpkg as misl) = S.ImportDecl (getPointLoc l) (sModuleName mn) qu src mpkg (fmap sModuleName as) (fmap sImportSpecList misl) sImportSpecList :: ImportSpecList l -> (Bool, [S.ImportSpec]) sImportSpecList (ImportSpecList _ b iss) = (b, map sImportSpec iss) sImportSpec :: ImportSpec l -> S.ImportSpec sImportSpec is = case is of IVar _ n -> S.IVar (sName n) IAbs _ n -> S.IAbs (sName n) IThingAll _ n -> S.IThingAll (sName n) IThingWith _ n cns -> S.IThingWith (sName n) (map sCName cns) sAssoc :: Assoc l -> S.Assoc sAssoc a = case a of AssocNone _ -> S.AssocNone AssocLeft _ -> S.AssocLeft AssocRight _ -> S.AssocRight sDeclHead :: DeclHead l -> (S.Name, [S.TyVarBind]) sDeclHead dh = case dh of DHead _ n tvs -> (sName n, map sTyVarBind tvs) DHInfix _ tva n tvb -> (sName n, map sTyVarBind [tva,tvb]) DHParen _ dh -> sDeclHead dh sInstHead :: InstHead l -> (S.QName, [S.Type]) sInstHead ih = case ih of IHead _ qn ts -> (sQName qn, map sType ts) IHInfix _ ta qn tb -> (sQName qn, map sType [ta,tb]) IHParen _ ih -> sInstHead ih sDataOrNew :: DataOrNew l -> S.DataOrNew sDataOrNew (DataType _) = S.DataType sDataOrNew (NewType _) = S.NewType sDeriving :: (Deriving l) -> [(S.QName, [S.Type])] sDeriving (Deriving _ ihs) = map sInstHead ihs sBinds :: SrcInfo loc => Binds loc -> S.Binds sBinds bs = case bs of BDecls _ decls -> S.BDecls (map sDecl decls) IPBinds _ ipbds -> S.IPBinds (map sIPBind ipbds) sIPBind :: SrcInfo loc => IPBind loc -> S.IPBind sIPBind (IPBind l ipn e) = S.IPBind (getPointLoc l) (sIPName ipn) (sExp e) sMatch :: SrcInfo loc => Match loc -> S.Match sMatch (Match l n ps rhs mwhere) = S.Match (getPointLoc l) (sName n) (map sPat ps) Nothing (sRhs rhs) (maybe (S.BDecls []) sBinds mwhere) sMatch (InfixMatch l pa n pbs rhs mwhere) = S.Match (getPointLoc l) (sName n) (map sPat (pa:pbs)) Nothing (sRhs rhs) (maybe (S.BDecls []) sBinds mwhere) sQualConDecl :: SrcInfo loc => QualConDecl loc -> S.QualConDecl sQualConDecl (QualConDecl l mtvs mctxt cd) = S.QualConDecl (getPointLoc l) (maybe [] (map sTyVarBind) mtvs) (maybe [] sContext mctxt) (sConDecl cd) sConDecl :: ConDecl l -> S.ConDecl sConDecl cd = case cd of ConDecl _ n bts -> S.ConDecl (sName n) (map sBangType bts) InfixConDecl _ bta n btb -> S.InfixConDecl (sBangType bta) (sName n) (sBangType btb) RecDecl _ n fds -> S.RecDecl (sName n) (map sFieldDecl fds) sFieldDecl :: FieldDecl l -> ([S.Name], S.BangType) sFieldDecl (FieldDecl _ ns bt) = (map sName ns, sBangType bt) sGadtDecl :: SrcInfo loc => GadtDecl loc -> S.GadtDecl sGadtDecl (GadtDecl l n t) = S.GadtDecl (getPointLoc l) (sName n) (sType t) sClassDecl :: SrcInfo loc => ClassDecl loc -> S.ClassDecl sClassDecl cd = case cd of ClsDecl _ d -> S.ClsDecl (sDecl d) ClsDataFam l mctxt dh mk -> let (n, tvs) = sDeclHead dh in S.ClsDataFam (getPointLoc l) (maybe [] sContext mctxt) n tvs (fmap sKind mk) ClsTyFam l dh mk -> let (n, tvs) = sDeclHead dh in S.ClsTyFam (getPointLoc l) n tvs (fmap sKind mk) ClsTyDef l t1 t2 -> S.ClsTyDef (getPointLoc l) (sType t1) (sType t2) sInstDecl :: SrcInfo loc => InstDecl loc -> S.InstDecl sInstDecl id = case id of InsDecl _ d -> S.InsDecl (sDecl d) InsType l t1 t2 -> S.InsType (getPointLoc l) (sType t1) (sType t2) InsData l dn t constrs mder -> S.InsData (getPointLoc l) (sDataOrNew dn) (sType t) (map sQualConDecl constrs) (maybe [] sDeriving mder) InsGData l dn t mk gds mder -> S.InsGData (getPointLoc l) (sDataOrNew dn) (sType t) (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder) -- InsInline l b mact qn -> S.InsInline (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn) sBangType :: BangType l -> S.BangType sBangType bt = case bt of BangedTy _ t -> S.BangedTy (sType t) UnBangedTy _ t -> S.UnBangedTy (sType t) UnpackedTy _ t -> S.UnpackedTy (sType t) sRhs :: SrcInfo loc => Rhs loc -> S.Rhs sRhs (UnGuardedRhs _ e) = S.UnGuardedRhs (sExp e) sRhs (GuardedRhss _ grhss) = S.GuardedRhss (map sGuardedRhs grhss) sGuardedRhs :: SrcInfo loc => GuardedRhs loc -> S.GuardedRhs sGuardedRhs (GuardedRhs l ss e) = S.GuardedRhs (getPointLoc l) (map sStmt ss) (sExp e) sType :: Type l -> S.Type sType t = case t of TyForall _ mtvs mctxt t -> S.TyForall (fmap (map sTyVarBind) mtvs) (maybe [] sContext mctxt) (sType t) TyFun _ t1 t2 -> S.TyFun (sType t1) (sType t2) TyTuple _ bx ts -> S.TyTuple bx (map sType ts) TyList _ t -> S.TyList (sType t) TyApp _ t1 t2 -> S.TyApp (sType t1) (sType t2) TyVar _ n -> S.TyVar (sName n) TyCon _ qn -> S.TyCon (sQName qn) TyParen _ t -> S.TyParen (sType t) TyInfix _ ta qn tb -> S.TyInfix (sType ta) (sQName qn) (sType tb) TyKind _ t k -> S.TyKind (sType t) (sKind k) sTyVarBind :: TyVarBind l -> S.TyVarBind sTyVarBind (KindedVar _ n k) = S.KindedVar (sName n) (sKind k) sTyVarBind (UnkindedVar _ n) = S.UnkindedVar (sName n) sKind :: Kind l -> S.Kind sKind k = case k of KindStar _ -> S.KindStar KindBang _ -> S.KindBang KindFn _ k1 k2 -> S.KindFn (sKind k1) (sKind k2) KindParen _ k -> S.KindParen (sKind k) KindVar _ n -> S.KindVar (sName n) sFunDep :: FunDep l -> S.FunDep sFunDep (FunDep _ as bs) = S.FunDep (map sName as) (map sName bs) sContext :: Context l -> S.Context sContext ctxt = case ctxt of CxSingle _ asst -> [sAsst asst] CxTuple _ assts -> map sAsst assts CxParen _ ct -> sContext ct CxEmpty _ -> [] sAsst :: Asst l -> S.Asst sAsst asst = case asst of ClassA _ qn ts -> S.ClassA (sQName qn) (map sType ts) InfixA _ ta qn tb -> S.InfixA (sType ta) (sQName qn) (sType tb) IParam _ ipn t -> S.IParam (sIPName ipn) (sType t) EqualP _ t1 t2 -> S.EqualP (sType t1) (sType t2) sLiteral :: Literal l -> S.Literal sLiteral lit = case lit of Char _ c _ -> S.Char c String _ s _ -> S.String s Int _ i _ -> S.Int i Frac _ r _ -> S.Frac r PrimInt _ i _ -> S.PrimInt i PrimWord _ i _ -> S.PrimWord i PrimFloat _ r _ -> S.PrimFloat r PrimDouble _ r _ -> S.PrimDouble r PrimChar _ c _ -> S.PrimChar c PrimString _ s _ -> S.PrimString s sExp :: SrcInfo loc => Exp loc -> S.Exp sExp e = case e of Var _ qn -> S.Var (sQName qn) IPVar _ ipn -> S.IPVar (sIPName ipn) Con _ qn -> S.Con (sQName qn) Lit _ lit -> S.Lit (sLiteral lit) InfixApp _ e1 op e2 -> S.InfixApp (sExp e1) (sQOp op) (sExp e2) App _ e1 e2 -> S.App (sExp e1) (sExp e2) NegApp _ e -> S.NegApp (sExp e) Lambda l ps e -> S.Lambda (getPointLoc l) (map sPat ps) (sExp e) Let _ bs e -> S.Let (sBinds bs) (sExp e) If _ e1 e2 e3 -> S.If (sExp e1) (sExp e2) (sExp e3) Case _ e alts -> S.Case (sExp e) (map sAlt alts) Do _ ss -> S.Do (map sStmt ss) MDo _ ss -> S.MDo (map sStmt ss) Tuple _ bx es -> S.Tuple bx (map sExp es) TupleSection _ bx mes -> S.TupleSection bx (map (fmap sExp) mes) List _ es -> S.List (map sExp es) Paren _ e -> S.Paren (sExp e) LeftSection _ e op -> S.LeftSection (sExp e) (sQOp op) RightSection _ op e -> S.RightSection (sQOp op) (sExp e) RecConstr _ qn fups -> S.RecConstr (sQName qn) (map sFieldUpdate fups) RecUpdate _ e fups -> S.RecUpdate (sExp e) (map sFieldUpdate fups) EnumFrom _ e -> S.EnumFrom (sExp e) EnumFromTo _ e1 e2 -> S.EnumFromTo (sExp e1) (sExp e2) EnumFromThen _ e1 e2 -> S.EnumFromThen (sExp e1) (sExp e2) EnumFromThenTo _ e1 e2 e3 -> S.EnumFromThenTo (sExp e1) (sExp e2) (sExp e3) ListComp _ e qss -> S.ListComp (sExp e) (map sQualStmt qss) ParComp _ e qsss -> S.ParComp (sExp e) (map (map sQualStmt) qsss) ExpTypeSig l e t -> S.ExpTypeSig (getPointLoc l) (sExp e) (sType t) VarQuote _ qn -> S.VarQuote (sQName qn) TypQuote _ qn -> S.TypQuote (sQName qn) BracketExp _ br -> S.BracketExp (sBracket br) SpliceExp _ sp -> S.SpliceExp (sSplice sp) QuasiQuote _ nm qt -> S.QuasiQuote nm qt XTag l xn attrs mat es -> S.XTag (getPointLoc l) (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es) XETag l xn attrs mat -> S.XETag (getPointLoc l) (sXName xn) (map sXAttr attrs) (fmap sExp mat) XPcdata _ str -> S.XPcdata str XExpTag _ e -> S.XExpTag (sExp e) XChildTag l es -> S.XChildTag (getPointLoc l) (map sExp es) CorePragma _ str e -> S.CorePragma str (sExp e) SCCPragma _ str e -> S.SCCPragma str (sExp e) GenPragma _ str i12 i34 e -> S.GenPragma str i12 i34 (sExp e) Proc l p e -> S.Proc (getPointLoc l) (sPat p) (sExp e) LeftArrApp _ e1 e2 -> S.LeftArrApp (sExp e1) (sExp e2) RightArrApp _ e1 e2 -> S.RightArrApp (sExp e1) (sExp e2) LeftArrHighApp _ e1 e2 -> S.LeftArrHighApp (sExp e1) (sExp e2) RightArrHighApp _ e1 e2 -> S.RightArrHighApp (sExp e1) (sExp e2) sXName :: XName l -> S.XName sXName (XName _ str) = S.XName str sXName (XDomName _ dom str) = S.XDomName dom str sXAttr :: SrcInfo loc => XAttr loc -> S.XAttr sXAttr (XAttr _ xn e) = S.XAttr (sXName xn) (sExp e) sBracket:: SrcInfo loc => Bracket loc -> S.Bracket sBracket br = case br of ExpBracket _ e -> S.ExpBracket (sExp e) PatBracket _ p -> S.PatBracket (sPat p) TypeBracket _ t -> S.TypeBracket (sType t) DeclBracket _ ds -> S.DeclBracket (map sDecl ds) sSplice :: SrcInfo loc => Splice loc -> S.Splice sSplice (IdSplice _ str) = S.IdSplice str sSplice (ParenSplice _ e) = S.ParenSplice (sExp e) sSafety :: Safety l -> S.Safety sSafety (PlayRisky _) = S.PlayRisky sSafety (PlaySafe _ b) = S.PlaySafe b sSafety (PlayInterruptible _) = S.PlayInterruptible sCallConv :: CallConv l -> S.CallConv sCallConv (StdCall _) = S.StdCall sCallConv (CCall _) = S.CCall sCallConv (CPlusPlus _) = S.CPlusPlus sCallConv (DotNet _) = S.DotNet sCallConv (Jvm _) = S.Jvm sCallConv (Js _) = S.Js sCallConv (CApi _) = S.CApi sModulePragma :: SrcInfo loc => ModulePragma loc -> S.ModulePragma sModulePragma pr = case pr of LanguagePragma l ns -> S.LanguagePragma (getPointLoc l) (map sName ns) OptionsPragma l mt str -> S.OptionsPragma (getPointLoc l) mt str AnnModulePragma l ann -> S.AnnModulePragma (getPointLoc l) (sAnnotation ann) sActivation :: Activation l -> S.Activation sActivation act = case act of ActiveFrom _ k -> S.ActiveFrom k ActiveUntil _ k -> S.ActiveUntil k sRule :: SrcInfo loc => Rule loc -> S.Rule sRule (Rule _ str mact mrvs e1 e2) = S.Rule str (maybe S.AlwaysActive sActivation mact) (fmap (map sRuleVar) mrvs) (sExp e1) (sExp e2) sRuleVar :: RuleVar l -> S.RuleVar sRuleVar (RuleVar _ n) = S.RuleVar (sName n) sRuleVar (TypedRuleVar _ n t) = S.TypedRuleVar (sName n) (sType t) sWarningText :: WarningText l -> S.WarningText sWarningText (DeprText _ str) = S.DeprText str sWarningText (WarnText _ str) = S.WarnText str sPat :: SrcInfo loc => Pat loc -> S.Pat sPat pat = case pat of PVar _ n -> S.PVar (sName n) PLit _ lit -> S.PLit (sLiteral lit) PNeg _ p -> S.PNeg (sPat p) PNPlusK _ n k -> S.PNPlusK (sName n) k PInfixApp _ pa qn pb -> S.PInfixApp (sPat pa) (sQName qn) (sPat pb) PApp _ qn ps -> S.PApp (sQName qn) (map sPat ps) PTuple _ bx ps -> S.PTuple bx (map sPat ps) PList _ ps -> S.PList (map sPat ps) PParen _ p -> S.PParen (sPat p) PRec _ qn pfs -> S.PRec (sQName qn) (map sPatField pfs) PAsPat _ n p -> S.PAsPat (sName n) (sPat p) PWildCard _ -> S.PWildCard PIrrPat _ p -> S.PIrrPat (sPat p) PatTypeSig l p t -> S.PatTypeSig (getPointLoc l) (sPat p) (sType t) PViewPat _ e p -> S.PViewPat (sExp e) (sPat p) PRPat _ rps -> S.PRPat (map sRPat rps) PXTag l xn attrs mat ps -> S.PXTag (getPointLoc l) (sXName xn) (map sPXAttr attrs) (fmap sPat mat) (map sPat ps) PXETag l xn attrs mat -> S.PXETag (getPointLoc l) (sXName xn) (map sPXAttr attrs) (fmap sPat mat) PXPcdata _ str -> S.PXPcdata str PXPatTag _ p -> S.PXPatTag (sPat p) PXRPats _ rps -> S.PXRPats (map sRPat rps) PExplTypeArg _ qn t -> S.PExplTypeArg (sQName qn) (sType t) PQuasiQuote _ nm qt -> S.PQuasiQuote nm qt PBangPat _ p -> S.PBangPat (sPat p) sPXAttr :: SrcInfo loc => PXAttr loc -> S.PXAttr sPXAttr (PXAttr _ xn p) = S.PXAttr (sXName xn) (sPat p) sRPatOp :: RPatOp l -> S.RPatOp sRPatOp rpop = case rpop of RPStar _ -> S.RPStar RPStarG _ -> S.RPStarG RPPlus _ -> S.RPPlus RPPlusG _ -> S.RPPlusG RPOpt _ -> S.RPOpt RPOptG _ -> S.RPOptG sRPat :: SrcInfo loc => RPat loc -> S.RPat sRPat rp = case rp of RPOp _ rp rop -> S.RPOp (sRPat rp) (sRPatOp rop) RPEither _ rp1 rp2 -> S.RPEither (sRPat rp1) (sRPat rp2) RPSeq _ rps -> S.RPSeq (map sRPat rps) RPGuard _ p ss -> S.RPGuard (sPat p) (map sStmt ss) RPCAs _ n rp -> S.RPCAs (sName n) (sRPat rp) RPAs _ n rp -> S.RPAs (sName n) (sRPat rp) RPParen _ rp -> S.RPParen (sRPat rp) RPPat _ p -> S.RPPat (sPat p) sPatField :: SrcInfo loc => PatField loc -> S.PatField sPatField pf = case pf of PFieldPat _ qn p -> S.PFieldPat (sQName qn) (sPat p) PFieldPun _ n -> S.PFieldPun (sName n) PFieldWildcard _ -> S.PFieldWildcard sStmt :: SrcInfo loc => Stmt loc -> S.Stmt sStmt stmt = case stmt of Generator l p e -> S.Generator (getPointLoc l) (sPat p) (sExp e) Qualifier _ e -> S.Qualifier (sExp e) LetStmt _ bs -> S.LetStmt (sBinds bs) RecStmt _ ss -> S.RecStmt (map sStmt ss) sQualStmt :: SrcInfo loc => QualStmt loc -> S.QualStmt sQualStmt qs = case qs of QualStmt _ stmt -> S.QualStmt (sStmt stmt) ThenTrans _ e -> S.ThenTrans (sExp e) ThenBy _ e1 e2 -> S.ThenBy (sExp e1) (sExp e2) GroupBy _ e -> S.GroupBy (sExp e) GroupUsing _ e -> S.GroupUsing (sExp e) GroupByUsing _ e1 e2 -> S.GroupByUsing (sExp e1) (sExp e2) sFieldUpdate :: SrcInfo loc => FieldUpdate loc -> S.FieldUpdate sFieldUpdate fu = case fu of FieldUpdate _ qn e -> S.FieldUpdate (sQName qn) (sExp e) FieldPun _ n -> S.FieldPun (sName n) FieldWildcard _ -> S.FieldWildcard sAlt :: SrcInfo loc => Alt loc -> S.Alt sAlt (Alt l p galts mbs) = S.Alt (getPointLoc l) (sPat p) (sGuardedAlts galts) (maybe (S.BDecls []) sBinds mbs) sGuardedAlts :: SrcInfo loc => GuardedAlts loc -> S.GuardedAlts sGuardedAlts galts = case galts of UnGuardedAlt _ e -> S.UnGuardedAlt (sExp e) GuardedAlts _ gs -> S.GuardedAlts (map sGuardedAlt gs) sGuardedAlt :: SrcInfo loc => GuardedAlt loc -> S.GuardedAlt sGuardedAlt (GuardedAlt l ss e) = S.GuardedAlt (getPointLoc l) (map sStmt ss) (sExp e) haskell-src-exts-1.14.0/src/Language/Haskell/Exts/Annotated/Build.hs0000644000000000000000000002175012204617765023323 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Exts.Annotated.Build -- Copyright : (c) The GHC Team, 1997-2000, -- (c) Niklas Broberg 2004 -- License : BSD-style (see the file LICENSE.txt) -- -- Maintainer : Niklas Broberg, d00nibro@chalmers.se -- Stability : experimental -- Portability : portable -- -- This module contains combinators to use when building -- Haskell source trees programmatically, as opposed to -- parsing them from a string. The contents here are quite -- experimental and will likely receive a lot of attention -- when the rest has stabilised. -- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Annotated.Build ( -- * Syntax building functions name, -- :: String -> Name sym, -- :: String -> Name var, -- :: Name -> Exp op, -- :: Name -> QOp qvar, -- :: Module -> Name -> Exp pvar, -- :: Name -> Pat app, -- :: Exp -> Exp -> Exp infixApp, -- :: Exp -> QOp -> Exp -> Exp appFun, -- :: Exp -> [Exp] -> Exp pApp, -- :: Name -> [Pat] -> Pat tuple, -- :: [Exp] -> Exp pTuple, -- :: [Pat] -> Pat varTuple, -- :: [Name] -> Exp pvarTuple, -- :: [Name] -> Pat function, -- :: String -> Exp strE, -- :: String -> Exp charE, -- :: Char -> Exp intE, -- :: Integer -> Exp strP, -- :: String -> Pat charP, -- :: Char -> Pat intP, -- :: Integer -> Pat doE, -- :: [Stmt] -> Exp lamE, -- :: SrcLoc -> [Pat] -> Exp -> Exp letE, -- :: [Decl] -> Exp -> Exp caseE, -- :: Exp -> [Alt] -> Exp alt, -- :: SrcLoc -> Pat -> Exp -> Alt altGW, -- :: SrcLoc -> Pat -> [Stmt] -> Exp -> Binds -> Alt listE, -- :: [Exp] -> Exp eList, -- :: Exp peList, -- :: Pat paren, -- :: Exp -> Exp pParen, -- :: Pat -> Pat qualStmt, -- :: Exp -> Stmt genStmt, -- :: SrcLoc -> Pat -> Exp -> Stmt letStmt, -- :: [Decl] -> Stmt binds, -- :: [Decl] -> Binds noBinds, -- :: Binds wildcard, -- :: Pat genNames, -- :: String -> Int -> [Name] -- * More advanced building sfun, -- :: SrcLoc -> Name -> [Name] -> Rhs -> Binds -> Decl simpleFun, -- :: SrcLoc -> Name -> Name -> Exp -> Decl patBind, -- :: SrcLoc -> Pat -> Exp -> Decl patBindWhere, -- :: SrcLoc -> Pat -> Exp -> [Decl] -> Decl nameBind, -- :: SrcLoc -> Name -> Exp -> Decl metaFunction, -- :: String -> [Exp] -> Exp metaConPat -- :: String -> [Pat] -> Pat ) where import Language.Haskell.Exts.Annotated.Syntax ----------------------------------------------------------------------------- -- Help functions for Abstract syntax -- | An identifier with the given string as its name. -- The string should be a valid Haskell identifier. name :: l -> String -> Name l name = Ident -- | A symbol identifier. The string should be a valid -- Haskell symbol identifier. sym :: l -> String -> Name l sym = Symbol -- | A local variable as expression. var :: l -> Name l -> Exp l var l = Var l . UnQual l -- | Use the given identifier as an operator. op :: l -> Name l -> QOp l op l = QVarOp l . UnQual l -- | A qualified variable as expression. qvar :: l -> ModuleName l -> Name l -> Exp l qvar l m = Var l . Qual l m -- | A pattern variable. pvar :: l -> Name l -> Pat l pvar = PVar -- | Application of expressions by juxtaposition. app :: l -> Exp l -> Exp l -> Exp l app = App -- | Apply an operator infix. infixApp :: l -> Exp l -> QOp l -> Exp l -> Exp l infixApp = InfixApp -- | Apply a function to a list of arguments. appFun :: [l] -> Exp l -> [Exp l] -> Exp l appFun _ f [] = f appFun (l:ls) f (a:as) = appFun ls (app l f a) as -- | A constructor pattern, with argument patterns. pApp :: l -> Name l -> [Pat l] -> Pat l pApp l n = PApp l (UnQual l n) -- | A tuple expression. tuple :: l -> [Exp l] -> Exp l tuple l = Tuple l Boxed -- | A tuple pattern. pTuple :: l -> [Pat l] -> Pat l pTuple l = PTuple l Boxed -- | A tuple expression consisting of variables only. varTuple :: l -> [Name l] -> Exp l varTuple l ns = tuple l $ map (var l) ns -- | A tuple pattern consisting of variables only. pvarTuple :: l -> [Name l] -> Pat l pvarTuple l ns = pTuple l $ map (pvar l) ns -- | A function with a given name. function :: l -> String -> Exp l function l = var l . Ident l -- | A literal string expression. strE :: l -> String -> Exp l strE l s = Lit l $ String l s s -- | A literal character expression. charE :: l -> Char -> Exp l charE l c = Lit l $ Char l c [c] -- | A literal integer expression. intE :: l -> Integer -> Exp l intE l i = Lit l $ Int l i (show i) -- | A literal string pattern. strP :: l -> String -> Pat l strP l s = PLit l $ String l s s -- | A literal character pattern. charP :: l -> Char -> Pat l charP l c = PLit l $ Char l c [c] -- | A literal integer pattern. intP :: l -> Integer -> Pat l intP l i = PLit l $ Int l i (show i) -- | A do block formed by the given statements. -- The last statement in the list should be -- a 'Qualifier' expression. doE :: l -> [Stmt l] -> Exp l doE = Do -- | Lambda abstraction, given a list of argument -- patterns and an expression body. lamE :: l -> [Pat l] -> Exp l -> Exp l lamE = Lambda -- | A @let@ ... @in@ block. letE :: l -> [Decl l] -> Exp l -> Exp l letE l ds e = Let l (binds l ds) e -- | A @case@ expression. caseE :: l -> Exp l -> [Alt l] -> Exp l caseE = Case -- | An unguarded alternative in a @case@ expression. alt :: l -> Pat l -> Exp l -> Alt l alt l p e = Alt l p (unGAlt l e) Nothing -- | An alternative with a single guard in a @case@ expression. altGW :: l -> Pat l -> [Stmt l] -> Exp l -> Binds l -> Alt l altGW l p gs e w = Alt l p (gAlt l gs e) (Just w) -- | An unguarded righthand side of a @case@ alternative. unGAlt :: l -> Exp l -> GuardedAlts l unGAlt = UnGuardedAlt -- | An list of guarded righthand sides for a @case@ alternative. gAlts :: l -> [([Stmt l], Exp l)] -> GuardedAlts l gAlts l as = GuardedAlts l $ map (\(gs,e) -> GuardedAlt l gs e) as -- | A single guarded righthand side for a @case@ alternative. gAlt :: l -> [Stmt l] -> Exp l -> GuardedAlts l gAlt l gs e = gAlts l [(gs,e)] -- | A list expression. listE :: l -> [Exp l] -> Exp l listE = List -- | The empty list expression. eList :: l -> Exp l eList l = List l [] -- | The empty list pattern. peList :: l -> Pat l peList l = PList l [] -- | Put parentheses around an expression. paren :: l -> Exp l -> Exp l paren = Paren -- | Put parentheses around a pattern. pParen :: l -> Pat l -> Pat l pParen = PParen -- | A qualifier expression statement. qualStmt :: l -> Exp l -> Stmt l qualStmt = Qualifier -- | A generator statement: /pat/ @<-@ /exp/ genStmt :: l -> Pat l -> Exp l -> Stmt l genStmt = Generator -- | A @let@ binding group as a statement. letStmt :: l -> [Decl l] -> Stmt l letStmt l ds = LetStmt l $ binds l ds -- | Hoist a set of declarations to a binding group. binds :: l -> [Decl l] -> Binds l binds = BDecls -- | An empty binding group. noBinds :: l -> Binds l noBinds l = binds l [] -- | The wildcard pattern: @_@ wildcard :: l -> Pat l wildcard = PWildCard -- | Generate k names by appending numbers 1 through k to a given string. genNames :: l -> String -> Int -> [Name l] genNames l s k = [ Ident l $ s ++ show i | i <- [1..k] ] ------------------------------------------------------------------------------- -- Some more specialised help functions -- | A function with a single clause sfun :: l -> Name l -> [Name l] -> Rhs l -> Maybe (Binds l) -> Decl l sfun l f pvs rhs mbs = FunBind l [Match l f (map (pvar l) pvs) rhs mbs] -- | A function with a single clause, a single argument, no guards -- and no where declarations simpleFun :: l -> Name l -> Name l -> Exp l -> Decl l simpleFun l f a e = let rhs = UnGuardedRhs l e in sfun l f [a] rhs Nothing -- | A pattern bind where the pattern is a variable, and where -- there are no guards and no 'where' clause. patBind :: l -> Pat l -> Exp l -> Decl l patBind l p e = let rhs = UnGuardedRhs l e in PatBind l p Nothing rhs Nothing -- | A pattern bind where the pattern is a variable, and where -- there are no guards, but with a 'where' clause. patBindWhere :: l -> Pat l -> Exp l -> [Decl l] -> Decl l patBindWhere l p e ds = let rhs = UnGuardedRhs l e in PatBind l p Nothing rhs (Just $ binds l ds) -- | Bind an identifier to an expression. nameBind :: l -> Name l -> Exp l -> Decl l nameBind l n e = patBind l (pvar l n) e -- | Apply function of a given name to a list of arguments. metaFunction :: l -> String -> [Exp l] -> Exp l metaFunction l s es = mf l s (reverse es) where mf l s [] = var l $ name l s mf l s (e:es) = app l (mf l s es) e -- | Apply a constructor of a given name to a list of pattern -- arguments, forming a constructor pattern. metaConPat :: l -> String -> [Pat l] -> Pat l metaConPat l s ps = pApp l (name l s) ps